├── .github └── workflows │ └── ci.yml ├── .gitignore ├── .licensizer.yml ├── Changes ├── LICENSE ├── MANIFEST ├── MANIFEST.SKIP ├── Makefile.PL ├── README ├── adm ├── .cvsignore ├── cvskwexp ├── dbitest ├── fixhtml ├── ftp2sf ├── index.html ├── mkppm ├── podok ├── projects.txt ├── release ├── release-graph ├── sfupd ├── sourceforge │ ├── images │ │ ├── chainsaw2.jpg │ │ └── chainsaw2s.jpg │ ├── rel │ ├── relppm │ ├── upddoc │ ├── updindex │ └── www │ │ ├── index.html │ │ ├── l4p.ppt │ │ ├── log4perl8.jpg │ │ ├── log4perlz.jpg │ │ ├── login-website │ │ └── tshirt3.jpg ├── syncdh ├── updreadme └── urlchk ├── docs └── benchmark.results.txt ├── eg ├── L4pResurrectable.pm ├── benchmarks │ ├── Makefile │ └── simple ├── color ├── dupe-warning.conf ├── jabber.conf ├── l4p-tmpl ├── log4j-file-append-java.conf ├── log4j-file-append-perl.conf ├── log4j-manual-1.conf ├── log4j-manual-2.conf ├── log4j-manual-3.conf ├── log4j-utf8.conf ├── newsyslog-test ├── override_appender ├── prototype ├── syslog.pl └── yamlparser ├── ldap ├── log4perl-2.ldif ├── log4perl-unittest.ldif ├── log4perl.schema ├── migrate.pl └── testload.ldif ├── lib └── Log │ ├── Log4perl.pm │ └── Log4perl │ ├── Appender.pm │ ├── Appender │ ├── Buffer.pm │ ├── DBI.pm │ ├── File.pm │ ├── Limit.pm │ ├── RRDs.pm │ ├── Screen.pm │ ├── ScreenColoredLevels.pm │ ├── Socket.pm │ ├── String.pm │ ├── Synchronized.pm │ ├── TestArrayBuffer.pm │ ├── TestBuffer.pm │ └── TestFileCreeper.pm │ ├── Catalyst.pm │ ├── Config.pm │ ├── Config │ ├── BaseConfigurator.pm │ ├── DOMConfigurator.pm │ ├── LDAPConfigurator.pm │ ├── PropertyConfigurator.pm │ └── Watch.pm │ ├── DateFormat.pm │ ├── FAQ.pm │ ├── Filter.pm │ ├── Filter │ ├── Boolean.pm │ ├── LevelMatch.pm │ ├── LevelRange.pm │ ├── MDC.pm │ └── StringMatch.pm │ ├── InternalDebug.pm │ ├── JavaMap.pm │ ├── JavaMap │ ├── ConsoleAppender.pm │ ├── FileAppender.pm │ ├── JDBCAppender.pm │ ├── NTEventLogAppender.pm │ ├── RollingFileAppender.pm │ ├── SyslogAppender.pm │ └── TestBuffer.pm │ ├── Layout.pm │ ├── Layout │ ├── NoopLayout.pm │ ├── PatternLayout.pm │ ├── PatternLayout │ │ └── Multiline.pm │ └── SimpleLayout.pm │ ├── Level.pm │ ├── Logger.pm │ ├── MDC.pm │ ├── NDC.pm │ ├── Resurrector.pm │ ├── Util.pm │ └── Util │ ├── Semaphore.pm │ └── TimeTracker.pm ├── t ├── 001Level.t ├── 002Logger.t ├── 003Layout-Rr.t ├── 003Layout.t ├── 004Config.t ├── 005Config-Perl.t ├── 006Config-Java.t ├── 007LogPrio.t ├── 008ConfCat.t ├── 009Deuce.t ├── 010JConsole.t ├── 011JFile.t ├── 012Deeper.t ├── 013Bench.t ├── 014ConfErrs.t ├── 015fltmsg.t ├── 016Export.t ├── 017Watch.t ├── 018Init.t ├── 019Warn.t ├── 020Easy.t ├── 020Easy2.t ├── 021AppThres.t ├── 022Wrap.t ├── 023Date.t ├── 024WarnDieCarp.t ├── 025CustLevels.t ├── 026FileApp.t ├── 027Watch2.t ├── 027Watch3.t ├── 027Watch4.t ├── 028Additivity.t ├── 029SysWide.t ├── 030LDLevel.t ├── 031NDC.t ├── 032JRollFile.t ├── 033UsrCspec.t ├── 034DBI.t ├── 035JDBCAppender.t ├── 036JSyslog.t ├── 037JWin32Event.t ├── 038XML-DOM1.t ├── 039XML-DOM2.t ├── 040Filter.t ├── 041SafeEval.t ├── 042SyncApp.t ├── 043VarSubst.t ├── 044XML-Filter.t ├── 045Composite.t ├── 046RRDs.t ├── 047-ldap.t ├── 048lwp.t ├── 049Unhide.t ├── 050Buffer.t ├── 051Extra.t ├── 052Utf8.t ├── 053Resurrect.t ├── 054Subclass.t ├── 055AppDestroy.t ├── 056SyncApp2.t ├── 057MsgChomp.t ├── 058Warnings.t ├── 059Wrapper.t ├── 060Initialized.t ├── 061Multiline.t ├── 062InitHash.t ├── 063LoggerRemove.t ├── 064RealClass.t ├── 065Undef.t ├── 066SQLite.t ├── 067Exception.t ├── 068MultilineIndented.t ├── 069MoreMultiline.t ├── 070UTCDate.t ├── 071ScreenStdoutStderr.t ├── deeper1.expected ├── deeper6.expected ├── deeper7.expected ├── lib │ └── Log4perlInternalTest.pm └── testdisp.pl └── xml ├── log4j-1.2.dtd └── log4perl.dtd /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: ci 2 | 3 | on: 4 | push: 5 | branches: 6 | - '*' 7 | tags-ignore: 8 | - '*' 9 | pull_request: 10 | 11 | jobs: 12 | 13 | ubuntu: 14 | env: 15 | PERL_USE_UNSAFE_INC: 0 16 | AUTHOR_TESTING: 1 17 | AUTOMATED_TESTING: 1 18 | RELEASE_TESTING: 1 19 | 20 | runs-on: ubuntu-latest 21 | 22 | steps: 23 | - uses: actions/checkout@v3 24 | - run: perl -V 25 | - name: Install dependencies 26 | uses: perl-actions/install-with-cpanm@stable 27 | with: 28 | args: --with-develop --with-recommends . 29 | - run: sudo perl Makefile.PL 30 | - run: sudo make 31 | - run: make test 32 | - run: sudo make install 33 | 34 | linux: 35 | name: "linux ${{ matrix.perl-version }}" 36 | needs: [ubuntu] 37 | runs-on: ubuntu-latest 38 | strategy: 39 | fail-fast: false 40 | matrix: 41 | os: [ubuntu-latest] 42 | perl-version: [ 43 | "5.36", 44 | "5.34", 45 | "5.30", 46 | "5.14", 47 | "5.10" 48 | ] 49 | include: 50 | - perl-version: '5.32' 51 | os: ubuntu-latest 52 | more-test: true 53 | coverage: true 54 | 55 | container: 56 | image: perldocker/perl-tester:${{ matrix.perl-version }} 57 | 58 | steps: 59 | - uses: actions/checkout@v3 60 | - name: Install deps 61 | uses: perl-actions/install-with-cpanm@stable 62 | with: 63 | args: --installdeps . 64 | sudo: false 65 | - run: perl -V 66 | - name: Install extra deps 67 | if: ${{ matrix.more-test }} 68 | uses: perl-actions/install-with-cpanm@stable 69 | with: 70 | args: --with-develop --with-recommends . 71 | sudo: false 72 | - name: Run tests 73 | if: ${{ !matrix.coverage }} 74 | run: prove -l -j4 t 75 | - name: Run tests (with coverage) 76 | if: ${{ matrix.coverage }} 77 | env: 78 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 79 | run: | 80 | cpanm -n Devel::Cover::Report::Coveralls 81 | HARNESS_OPTIONS='j4' cover -test -report Coveralls 82 | 83 | non-linux: 84 | runs-on: ${{ matrix.os }} 85 | needs: [ubuntu] 86 | strategy: 87 | fail-fast: false 88 | matrix: 89 | os: [macos-latest, windows-latest] 90 | steps: 91 | - uses: actions/checkout@v3 92 | - uses: shogo82148/actions-setup-perl@v1 93 | with: 94 | distribution: strawberry # ignored non-windows 95 | - uses: perl-actions/install-with-cpanm@stable 96 | with: 97 | args: --installdeps . 98 | - run: perl -V 99 | - name: Run tests 100 | run: prove -l -j4 t 101 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | MANIFEST.bak 2 | Makefile 3 | blib 4 | pm_to_blib 5 | MYMETA.json 6 | MYMETA.yml 7 | *.log 8 | -------------------------------------------------------------------------------- /.licensizer.yml: -------------------------------------------------------------------------------- 1 | # .licensizer.yml 2 | author: | 3 | Please contribute patches to the project on Github: 4 | 5 | http://github.com/mschilli/log4perl 6 | 7 | Send bug reports or requests for enhancements to the authors via our 8 | 9 | MAILING LIST (questions, bug reports, suggestions/patches): 10 | log4perl-devel@lists.sourceforge.net 11 | 12 | Authors (please contact them via the list above, not directly): 13 | Mike Schilli , 14 | Kevin Goess 15 | 16 | Contributors (in alphabetical order): 17 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 18 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 19 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 20 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 21 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 22 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 23 | Lars Thegler, David Viner, Mac Yang. 24 | 25 | license: | 26 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 27 | and Kevin Goess Ecpan@goess.orgE. 28 | 29 | This library is free software; you can redistribute it and/or modify 30 | it under the same terms as Perl itself. 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | =head1 COPYRIGHT AND LICENSE 2 | 3 | Copyright 2002-2012 by 4 | Mike Schilli and Kevin Goess . 5 | 6 | This library is free software; you can redistribute it and/or modify 7 | it under the same terms as Perl itself. 8 | 9 | =cut 10 | 11 | THE SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTIES OF ANY KIND, 12 | INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OF ACCURACY OR 13 | COMPLETENESS OF ANY INFORMATION CONTAINED IN THE SOFTWARE OR IMPLIED 14 | WARRANTIES OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. 15 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | .gz$ 2 | .travis.yml 3 | blib 4 | ^Makefile$ 5 | ^Makefile.old$ 6 | ^modules 7 | ^Log4perl.pm 8 | CVS 9 | docs 10 | lib/Log/Dispatch 11 | MANIFEST.bak 12 | MANIFEST.old 13 | adm 14 | ldap/log4perl.schema 15 | ldap/migrate.pl 16 | lib/Log/Log4perl/Config/LDAPConfigurator.pm 17 | t/047-ldap.t 18 | .git 19 | test.log 20 | MYMETA.json 21 | MYMETA.yml 22 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use ExtUtils::MakeMaker; 4 | 5 | my $meta_merge = { 6 | META_MERGE => { 7 | "meta-spec" => { version => 2 }, 8 | resources => { 9 | repository => { 10 | type => 'git', 11 | url => 'git@github.com:mschilli/log4perl.git', 12 | web => 'https://github.com/mschilli/log4perl', 13 | }, 14 | MailingList => 'mailto:log4perl-devel@lists.sourceforge.net', 15 | bugtracker => { 16 | web => 'https://github.com/mschilli/log4perl/issues', 17 | }, 18 | }, 19 | prereqs => { 20 | runtime => { 21 | recommends => { 22 | 'Log::Dispatch' => 0, 23 | 'DBI' => '1.607', 24 | 'DBD::SQLite' => 0, 25 | 'DBD::CSV' => '0.33', 26 | 'SQL::Statement' => '1.20', 27 | 'Log::Dispatch::FileRotate' => '1.10', 28 | 'XML::DOM' => '1.29', 29 | }, 30 | requires => { 31 | 'File::Spec' => '0.82', 32 | 'File::Path' => '2.07', 33 | }, 34 | }, 35 | test => { 36 | requires => { 37 | 'Test::More' => '0.88', # done_testing 38 | }, 39 | }, 40 | }, 41 | } 42 | }; 43 | 44 | WriteMakefile( 45 | 'NAME' => 'Log::Log4perl', 46 | 'VERSION_FROM' => 'lib/Log/Log4perl.pm', # finds $VERSION 47 | ABSTRACT_FROM => 'lib/Log/Log4perl.pm', # retrieve abstract from module 48 | AUTHOR => 'Mike Schilli ', 49 | MIN_PERL_VERSION => '5.006', 50 | 'clean' => {FILES => "*.tar.gz *.ppd pod2htm*"}, 51 | EXE_FILES => ["eg/l4p-tmpl"], 52 | LICENSE => 'perl_5', 53 | $ExtUtils::MakeMaker::VERSION >= 6.50 ? (%$meta_merge) : (), 54 | get_man3pods(), 55 | ); 56 | 57 | ########################################## 58 | sub get_man3pods { 59 | ########################################## 60 | # Only done for versions < 5.8.0 61 | return () if $] >= 5.008; 62 | 63 | print <) { 17 | die "$file: $_" if /\$\s*Log.*\$/; 18 | } 19 | close FILE; 20 | }, "."); 21 | -------------------------------------------------------------------------------- /adm/dbitest: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl -w 2 | ########################################### 3 | # xx -- 4 | # Mike Schilli, 2010 (m@perlmeister.com) 5 | ########################################### 6 | use strict; 7 | use Sysadm::Install qw(:all); 8 | use Log::Log4perl qw(:easy); 9 | 10 | my $config = q{ 11 | log4j.category = WARN, DBAppndr 12 | log4j.appender.DBAppndr = Log::Log4perl::Appender::DBI 13 | log4j.appender.DBAppndr.datasource = DBI:mysql:database=dbiapp 14 | log4j.appender.DBAppndr.username = root 15 | log4j.appender.DBAppndr.password = 16 | log4j.appender.DBAppndr.sql = \ 17 | insert into log4perltest1 \ 18 | (message) values (?) 19 | log4j.appender.DBAppndr.usePreparedStmt = 1 20 | 21 | # just pass through the array of message items in the log statement 22 | log4j.appender.DBAppndr.layout = Log::Log4perl::Layout::NoopLayout 23 | log4j.appender.DBAppndr.warp_message = 0 24 | }; 25 | use Log::Log4perl qw(:easy); 26 | Log::Log4perl->init( \$config ); 27 | 28 | my $logger = get_logger(); 29 | $logger->warn( 'big problem!!' ); 30 | -------------------------------------------------------------------------------- /adm/fixhtml: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl -p -i 2 | ########################################### 3 | # fixhtml - compensate for pod2html bugs 4 | # Mike Schilli, 2004 (m@perlmeister.com) 5 | ########################################### 6 | 7 | # "">http://log4perl.sourceforge.net/ppm/Log-Log4perl.ppd"; 8 | s/""/"/g; 9 | s#";#"#; 10 | -------------------------------------------------------------------------------- /adm/ftp2sf: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | ########################################### 3 | # xx -- 4 | # Mike Schilli, 2003 (m@perlmeister.com) 5 | ########################################### 6 | use warnings; 7 | use strict; 8 | 9 | use Net::FTP; 10 | 11 | my $ftp = Net::FTP->new('upload.sourceforge.net'); 12 | $ftp->login('anonymous', 'a@b.com') or die "Cannot login"; 13 | $ftp->cwd('incoming') or die "Cannot chdir"; 14 | my $gz = <*.gz>; 15 | $ftp->put($gz) or die "Cannot put"; 16 | $ftp->quit(); 17 | -------------------------------------------------------------------------------- /adm/mkppm: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | ########################################### 3 | # Build ppm balls for Log4perl and all of 4 | # its dependencies 5 | # Mike Schilli, 2002 (m@perlmeister.com) 6 | ########################################### 7 | use warnings; 8 | use strict; 9 | 10 | use LWP::Simple; 11 | use File::Basename; 12 | use File::Path; 13 | use File::Copy; 14 | use Log::Log4perl qw(:easy); 15 | use PPM::Make; 16 | 17 | Log::Log4perl->easy_init({level => $DEBUG, 18 | file => 'stdout', 19 | layout => '%m%n', 20 | }); 21 | 22 | my $PPM_DIR = "ppm"; 23 | my $TAR = "tar"; 24 | my $GZIP = "gzip"; 25 | 26 | if(-d $PPM_DIR) { 27 | rmtree $PPM_DIR or LOGDIE("Cannot delete $PPM_DIR"); 28 | } 29 | 30 | my ($log4perl_tarball) = <../Log-Log4perl-*.tar.gz>; 31 | LOGDIE("No tarball for Log4perl found") unless defined $log4perl_tarball; 32 | 33 | mkdir $PPM_DIR, 0755 or LOGDIE("Cannot mkdir $PPM_DIR"); 34 | ppm_make("Log::Log4perl", $log4perl_tarball); 35 | 36 | ########################################### 37 | sub ppm_make { 38 | ########################################### 39 | my($module, $file) = @_; 40 | 41 | DEBUG("ppm_make $module $file"); 42 | 43 | (my $mod_dir = $module) =~ s/::/-/g; 44 | 45 | my @files = (); 46 | 47 | open PIPE, "$TAR ztf $file |" or LOGDIE("Can't open $TAR ($!)"); 48 | while() { 49 | chomp; 50 | push @files, $_; 51 | } 52 | close PIPE or LOGDIE("Can't untar $file ($!)"); 53 | 54 | DEBUG("Archive contains ", scalar @files, " files"); 55 | 56 | (my $topdir = $files[0]) =~ s#/.*##; 57 | 58 | if(-d $topdir) { 59 | rmtree $topdir or LOGDIE("Cannot delete $topdir"); 60 | } 61 | 62 | DEBUG("Unpacking $file"); 63 | 64 | system("$TAR zxf $file") and LOGDIE("Cannot untar $file"); 65 | 66 | DEBUG("$topdir ready"); 67 | 68 | chdir $topdir or LOGDIE("Cannot chdir to $topdir"); 69 | 70 | patch_log_dispatch() if $topdir =~ /Log-Dispatch/; 71 | 72 | my $ppm = PPM::Make->new(os => "", 73 | arch => "", 74 | vs => 1, 75 | no_remote_lookup => 1, 76 | ); 77 | $ppm->make_ppm(); 78 | 79 | my $ppd_file = glob "$mod_dir-*.ppd"; 80 | my $tar_file = glob "$mod_dir-*.tar.gz"; 81 | 82 | fix_ppd($ppd_file); 83 | 84 | copy($ppd_file, "../$PPM_DIR/$mod_dir.ppd") or die "Cannot copy $ppd_file"; 85 | copy("$tar_file", "../$PPM_DIR/$mod_dir.tar.gz") or 86 | die "Cannot copy $tar_file"; 87 | 88 | chdir ".." or LOGDIE("Cannot chdir to .."); 89 | 90 | rmtree $topdir or die "Can't delete $topdir"; 91 | #unlink $file; 92 | 93 | 1; 94 | } 95 | 96 | ########################################### 97 | sub fix_ppd { 98 | ########################################### 99 | my($ppd_file) = @_; 100 | 101 | open FILE, "<$ppd_file" or die "Cannot open $ppd_file"; 102 | my $data = join '', ; 103 | $data =~ s/-\d+\.\d+//g; 104 | close FILE; 105 | 106 | open FILE, ">$ppd_file" or die "Cannot open $ppd_file"; 107 | print FILE $data; 108 | close FILE; 109 | } 110 | 111 | ########################################### 112 | sub patch_log_dispatch { 113 | ########################################### 114 | 115 | # Get rid of Log::Dispatch's annoying user prompting 116 | 117 | open FILE, "; 119 | close FILE; 120 | 121 | $data =~ s/use ExtUtils.*/ 122 | use ExtUtils::MakeMaker qw(WriteMakefile); 123 | sub prompt { return \$_[1] } 124 | /; 125 | $data =~ s/while\s*\(\s*1\s*\)/while(0)/; 126 | 127 | open FILE, ">Makefile.PL" or die "Cannot open Makefile.PL (w)"; 128 | print FILE $data; 129 | close FILE; 130 | } 131 | -------------------------------------------------------------------------------- /adm/podok: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | ########################################### 3 | # Mike Schilli, 2002 (m@perlmeister.com) 4 | ########################################### 5 | use warnings; 6 | use strict; 7 | 8 | use Test::Pod; 9 | use Test::More; 10 | use File::Find; 11 | 12 | podok(@ARGV); 13 | 0; 14 | 15 | ################################################## 16 | sub podok { 17 | ################################################## 18 | my ($dir) = @_; 19 | 20 | $dir ||= "."; 21 | 22 | my @pms = (); 23 | 24 | File::Find::find( sub { 25 | return unless -f $_; 26 | return unless /\.pm$/; 27 | push @pms, "$File::Find::name"; 28 | }, $dir); 29 | 30 | my $nof_tests = scalar @pms; 31 | 32 | plan tests => $nof_tests; 33 | 34 | for(@pms) { 35 | pod_file_ok($_); 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /adm/projects.txt: -------------------------------------------------------------------------------- 1 | # Here's a list of CPAN modules already using Log::Log4perl: 2 | # 3 | App::Daemon 4 | Archive::Tar::Wrapper 5 | Authen::PAAS 6 | CPAN::Unwind 7 | Cache::Historical 8 | Catalyst::Log::Log4perl 9 | Config::Patch 10 | Data::Throttler 11 | File::Comments 12 | Gaim::Log::Mailer 13 | Gaim::Log::Parser 14 | IPC::Cmd::Cached 15 | JavaScript::SpiderMonkey 16 | Jifty 17 | Log::Dispatch::File::Rolling 18 | Log::Dispatch::FileRotate 19 | Log::Log4perl::Layout::XMLLayout 20 | Log::Statistics 21 | Mail::DWIM 22 | Module::Rename 23 | Nagios::Clientstatus 24 | Net::Amazon 25 | Perl::Configure 26 | Process::MaxSize 27 | RRDTool::OO 28 | Rose::DBx::Object::InternalPager 29 | SQL::Translator 30 | Sysadm::Install 31 | Text::Language::Guess 32 | Text::Scan::License 33 | Text::TermExtract 34 | Trash::Park 35 | WebService::ReviewBoard 36 | Workflow 37 | XML::RSS::FromHTML::Simple 38 | -------------------------------------------------------------------------------- /adm/release: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | ########################################### 3 | # release -- Release this module 4 | # Mike Schilli, 2002 (m@perlmeister.com) 5 | ########################################### 6 | # RELEASE checklist: 7 | # * Update log4perl project download page 8 | # Upload to upload.sourceforge.net 9 | # https://sourceforge.net/project/admin/newrelease.php?package_id=52323&group_id=56939 10 | # * Notify log4perl-devel 11 | # * Check 5.00503 compatibility 12 | ########################################### 13 | 14 | use warnings; 15 | use strict; 16 | 17 | # Available at http://perlmeister.com/scripts 18 | use lib "$ENV{HOME}/perl-modules"; 19 | use ModDevUtils; 20 | use ExtUtils::Manifest; 21 | use Test::Pod; 22 | use Test::More; 23 | use File::Find; 24 | use Test::Harness; 25 | 26 | my($devprod) = @ARGV; 27 | 28 | # system("adm/cvskwexp") and die "\$Log... detected"; 29 | 30 | # Check if all the POD complies with the standard 31 | my $admdir = "."; 32 | $admdir = "adm" if -d "lib"; 33 | runtests("$admdir/podok"); 34 | 35 | { 36 | no strict; 37 | no warnings 'redefine'; 38 | *ModDevUtils::main_pm_file = sub { "lib/Log/Log4perl.pm" }; 39 | } 40 | 41 | ModDevUtils::release(0) or exit 0; 42 | 43 | my @missing = ExtUtils::Manifest::manicheck(); 44 | 45 | if(@missing) { 46 | die "Manifest check failed, missing files: @missing"; 47 | } 48 | 49 | my $ball = ModDevUtils::tarball_name(); 50 | 51 | my $target = "mschilli,log4perl\@web.sourceforge.net:htdocs"; 52 | 53 | # now on CPAN 54 | # system("scp $ball $target/releases/$ball"); 55 | 56 | # Win32 package 57 | print "Building Win32 ppm distribution ...\n"; 58 | system("cd adm; ./mkppm; tar zcfv ppm.tgz ppm"); 59 | 60 | print "Copying ppm to log4perl.sourceforge.net ...\n"; 61 | system("scp adm/ppm/* $target/ppm"); 62 | 63 | system("adm/sourceforge/updindex $ball"); 64 | 65 | system("scp adm/sourceforge/www/index.html $target"); 66 | 67 | __END__ 68 | -------------------------------------------------------------------------------- /adm/release-graph: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl -w 2 | use strict; 3 | use Sysadm::Install qw(:all); 4 | use DateTime; 5 | use RRDTool::OO; 6 | use Log::Log4perl qw(:easy); 7 | Log::Log4perl->easy_init($DEBUG); 8 | 9 | my @points; 10 | 11 | my $ymd_date = qr(\d\d\d\d/\d\d/\d\d); 12 | my $mdy_date = qr(\d\d/\d\d/\d\d\d\d); 13 | my $version = qr(\d+\.\d+); 14 | 15 | my($y, $m, $d); 16 | 17 | my $last_time = undef; 18 | 19 | open FILE, ") { 21 | chomp; 22 | 23 | if(/^($version)\s+\(?(?:($ymd_date)|($mdy_date))/) { 24 | my $v = $1; 25 | if($2) { 26 | #ymd 27 | ($y, $m, $d) = split m#/#, $2; 28 | } else { 29 | #mdy 30 | ($m, $d, $y) = split m#/#, $3; 31 | } 32 | my $date = DateTime->new( 33 | year => $y, 34 | month => $m, 35 | day => $d, 36 | ); 37 | if(defined $last_time and $last_time == $date->epoch()) { 38 | next; 39 | } 40 | push @points, [$date->epoch(), $v]; 41 | $last_time = $date->epoch(); 42 | } 43 | } 44 | 45 | @points = reverse @points; 46 | 47 | # Constructor 48 | my $rrd = RRDTool::OO->new( 49 | file => "releases.rrd" ); 50 | 51 | # Create a round-robin database 52 | $rrd->create( 53 | step => 3600*24*1, 54 | start => $points[0]->[0] - 1, 55 | data_source => { name => "releases", 56 | type => "GAUGE" }, 57 | archive => { rows => 10_000 }); 58 | 59 | my $last_point; 60 | 61 | for(@points) { 62 | next if $last_point == $_->[0]; 63 | if(defined $last_point and 64 | $_->[0] - $last_point > 3600*24) { 65 | $last_point += 3600*24; 66 | $rrd->update(time => $last_point, 67 | value => $_->[1]); 68 | redo; 69 | } 70 | $rrd->update(time => $_->[0], 71 | value => $_->[1]); 72 | $last_point = $_->[0]; 73 | } 74 | 75 | $rrd->graph( 76 | width => 600, 77 | height => 400, 78 | image => "releases.png", 79 | vertical_label => "Version", 80 | start => $points[0]->[0], 81 | end => $points[-1]->[0], 82 | x_grid => "YEAR:1:YEAR:1:YEAR:1:0:%Y", 83 | draw => { 84 | type => "line", 85 | color => "0000FF", 86 | legend => "Log4perl Releases", 87 | } 88 | ); 89 | -------------------------------------------------------------------------------- /adm/sfupd: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | ###################################################################### 3 | # adm/sfupd -- 2003, Mike Schilli 4 | ###################################################################### 5 | # Update Net::Amazon on Sourceforge 6 | ###################################################################### 7 | use strict; 8 | use warnings; 9 | 10 | my $VERSION = "0.01"; 11 | our $CVSVERSION = '$Revision: 1.7 $'; 12 | 13 | use Net::Sourceforge; 14 | #use Log::Log4perl qw(:easy); 15 | #Log::Log4perl->easy_init($DEBUG); 16 | 17 | my $sf = Net::Sourceforge->new( 18 | sf_user => 'mschilli', 19 | sf_package_id => 52323, 20 | sf_group_id => 56939, 21 | ); 22 | 23 | $sf->readin_password(); 24 | 25 | $sf->ftp_upload(); 26 | $sf->sf_release(); 27 | 28 | __END__ 29 | 30 | =head1 NAME 31 | 32 | adm/sfupd - Update Net::Amazon on Sourceforge 33 | 34 | =head1 SYNOPSIS 35 | 36 | adm/sfupd 37 | 38 | =head1 DESCRIPTION 39 | 40 | Takes the first tarball it finds and pushes it up to the 41 | Log::Log4perl project page on sourceforge.net 42 | 43 | Uses Net::Sourceforge from Mike's script archive 44 | 45 | http://perlmeister.com/scripts 46 | 47 | =head1 EXAMPLES 48 | 49 | $ adm/sfupd 50 | 51 | =head1 LICENSE 52 | 53 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 54 | and Kevin Goess Ecpan@goess.orgE. 55 | 56 | This library is free software; you can redistribute it and/or modify 57 | it under the same terms as Perl itself. 58 | 59 | =head1 AUTHOR 60 | 61 | Please contribute patches to the project on Github: 62 | 63 | http://github.com/mschilli/log4perl 64 | 65 | Send bug reports or requests for enhancements to the authors via our 66 | 67 | MAILING LIST (questions, bug reports, suggestions/patches): 68 | log4perl-devel@lists.sourceforge.net 69 | 70 | Authors (please contact them via the list above, not directly): 71 | Mike Schilli , 72 | Kevin Goess 73 | 74 | Contributors (in alphabetical order): 75 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 76 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 77 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 78 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 79 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 80 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 81 | Lars Thegler, David Viner, Mac Yang. 82 | 83 | -------------------------------------------------------------------------------- /adm/sourceforge/images/chainsaw2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mschilli/log4perl/059d95bc49c0225ff889a6b71ee561016925891f/adm/sourceforge/images/chainsaw2.jpg -------------------------------------------------------------------------------- /adm/sourceforge/images/chainsaw2s.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mschilli/log4perl/059d95bc49c0225ff889a6b71ee561016925891f/adm/sourceforge/images/chainsaw2s.jpg -------------------------------------------------------------------------------- /adm/sourceforge/rel: -------------------------------------------------------------------------------- 1 | 2 | cp $1 /home/groups/l/lo/log4perl/htdocs/releases 3 | cd /home/groups/l/lo/log4perl/htdocs/releases 4 | tar zxfv $1 5 | dir=`echo $1 | sed 's/.tar.gz//'` 6 | rm -f Log-Log4perl 7 | ln -s $dir Log-Log4perl 8 | version=`echo $1 | sed 's/.\tar\.gz//' | sed 's/.*-//'` 9 | /home/users/m/ms/mschilli/bin/updindex $version $2 10 | /home/users/m/ms/mschilli/bin/upddoc 11 | -------------------------------------------------------------------------------- /adm/sourceforge/relppm: -------------------------------------------------------------------------------- 1 | 2 | cd /home/groups/l/lo/log4perl/htdocs 3 | tar zxfv /home/users/m/ms/mschilli/ppm.tgz 4 | 5 | #PPMDIR=/home/groups/l/lo/log4perl/htdocs/ppm 6 | #echo "copying Log-Log4perl.tar.gz to $PPMDIR ..." 7 | #cp Log-Log4perl.tar.gz $PPMDIR 8 | #echo "copying Log-Log4perl.ppd to $PPMDIR ..." 9 | #cp Log-Log4perl.ppd $PPMDIR 10 | -------------------------------------------------------------------------------- /adm/sourceforge/upddoc: -------------------------------------------------------------------------------- 1 | 2 | cd /home/groups/l/lo/log4perl/htdocs/releases/Log-Log4perl 3 | /home/users/m/ms/mschilli/bin/pod2htmltree /releases/Log-Log4perl 4 | -------------------------------------------------------------------------------- /adm/sourceforge/updindex: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | my $IDX = "index.html"; 4 | 5 | my ($version, $devprod) = @ARGV; 6 | 7 | $version =~ s/.*?(\d+[\.\d]+)\..*/$1/; 8 | 9 | die "usage: $0 version" unless $version =~ /^[\d.]+\w+$/; 10 | 11 | system "git checkout gh-pages" and die $!; 12 | 13 | open FILE, "<$IDX" or die "Cannot open $IDX"; 14 | my $data = join '', ; 15 | close FILE; 16 | 17 | my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); 18 | my $date = sprintf "%02d/%02d/%d", $mon+1, $mday, $year+1900; 19 | 20 | $data =~ s/.*?/repnews()/se; 21 | 22 | if(defined $devprod and $devprod =~ /(dev)|(alpha)|(beta)/) { 23 | $data =~ s@.*?@repdev()@se; 24 | } else { 25 | $data =~ s@.*?@repstable()@se; 26 | $data =~ s@.*?@\n@s; 27 | } 28 | 29 | open FILE, ">$IDX" or die "Cannot open $IDX"; 30 | print FILE $data; 31 | close FILE; 32 | 33 | system "git commit -a -mversion-bump" and die $!; 34 | system "git push origin gh-pages" and die $!; 35 | system "git checkout master" and die $!; 36 | 37 | ################################################## 38 | sub repnews { 39 | ################################################## 40 | return < 42 | $date:
43 | Released version $version
44 | 45 | EOT 46 | } 47 | 48 | ################################################## 49 | sub repstable { 50 | ################################################## 51 | return < 53 | Stable Release ($date) 54 | Log-Log4perl-$version.tar.gz 55 | 56 | EOT 57 | } 58 | 59 | ################################################## 60 | sub repdev { 61 | ################################################## 62 | return < 64 | Development Release ($date) 65 | Log-Log4perl-$version.tar.gz 66 | 67 | EOT 68 | } 69 | 70 | __END__ 71 | cp $1 /home/groups/l/lo/log4perl/htdocs/releases 72 | cd /home/groups/l/lo/log4perl/htdocs/releases 73 | tar zxfv $1 74 | dir=`echo $1 | sed 's/.tar.gz//'` 75 | rm -f Log-Log4perl 76 | ln -s $dir Log-Log4perl 77 | upddoc 78 | 79 | 80 | 08/08/2002:
81 | Released version 0.21 to CPAN.
82 | 83 | 84 |
85 | Documentation:

86 | Manual
87 | Changes 88 |

89 | Download:

90 | 91 | Stable Release (07/23/2002) 92 | Log-Log4perl-0.21.tar.gz 93 | 94 | 95 | -------------------------------------------------------------------------------- /adm/sourceforge/www/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 |

Log::Log4perl moved to github.com

5 | -------------------------------------------------------------------------------- /adm/sourceforge/www/l4p.ppt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mschilli/log4perl/059d95bc49c0225ff889a6b71ee561016925891f/adm/sourceforge/www/l4p.ppt -------------------------------------------------------------------------------- /adm/sourceforge/www/log4perl8.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mschilli/log4perl/059d95bc49c0225ff889a6b71ee561016925891f/adm/sourceforge/www/log4perl8.jpg -------------------------------------------------------------------------------- /adm/sourceforge/www/log4perlz.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mschilli/log4perl/059d95bc49c0225ff889a6b71ee561016925891f/adm/sourceforge/www/log4perlz.jpg -------------------------------------------------------------------------------- /adm/sourceforge/www/login-website: -------------------------------------------------------------------------------- 1 | 2 | sftp mschilli,log4perl@web.sourceforge.net 3 | -------------------------------------------------------------------------------- /adm/sourceforge/www/tshirt3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mschilli/log4perl/059d95bc49c0225ff889a6b71ee561016925891f/adm/sourceforge/www/tshirt3.jpg -------------------------------------------------------------------------------- /adm/syncdh: -------------------------------------------------------------------------------- 1 | 2 | git-update-server-info 3 | rsync -az .git/* walsh.dreamhost.com:perlmeister.com/log4perl.git 4 | -------------------------------------------------------------------------------- /adm/updreadme: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use warnings; 3 | use strict; 4 | 5 | # Can be obtained from http://perlmeister.com/scripts 6 | use ModDevUtils; 7 | 8 | { 9 | no strict; 10 | *ModDevUtils::main_pm_file = sub { "lib/Log/Log4perl.pm" }; 11 | } 12 | 13 | ModDevUtils::update_readme(); 14 | -------------------------------------------------------------------------------- /adm/urlchk: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | ########################################### 3 | # urlchk -- check all URLs in the docs 4 | # Mike Schilli, 2003 (m@perlmeister.com) 5 | ########################################### 6 | use warnings; 7 | use strict; 8 | 9 | use URI::Find; 10 | use File::Find::Rule; 11 | use LWP::Simple; 12 | 13 | my %URLS = (); 14 | 15 | for(File::Find::Rule->file()->in(".")) { 16 | 17 | next if m#\./blib/#; 18 | 19 | open FILE, "<$_" or die "Cannot open $_"; 20 | my $data = join '', ; 21 | close FILE; 22 | 23 | my $finder = URI::Find->new(sub { 24 | $URLS{$_[0]}->{$_}++; 25 | }); 26 | 27 | if(my $howmany = $finder->find(\$data)) { 28 | #print "$_ $howmany\n"; 29 | } 30 | } 31 | 32 | for my $url (keys %URLS) { 33 | if(get($url)) { 34 | next; 35 | } 36 | print "$url\n"; 37 | for my $file (sort keys %{$URLS{$url}}) { 38 | print " $file\n"; 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /eg/L4pResurrectable.pm: -------------------------------------------------------------------------------- 1 | package L4pResurrectable; 2 | use Log::Log4perl qw(:easy); 3 | use vars qw($VERSION); 4 | 5 | $VERSION = "0.01"; 6 | 7 | sub foo { 8 | ###l4p DEBUG "foo was here"; 9 | ###l4p INFO "bar was here"; 10 | } 11 | 12 | 1; 13 | -------------------------------------------------------------------------------- /eg/benchmarks/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: 3 | perl -I../../blib/lib -MLog::Log4perl -le 'print $$Log::Log4perl::VERSION' 4 | perl -I../../blib/lib ./simple 5 | 6 | master: 7 | cd ../..; git checkout master; perl Makefile.PL >/dev/null; make >/dev/null 8 | 9 | eval_free: 10 | cd ../..; git checkout eval_free; perl Makefile.PL >/dev/null; make >/dev/null 11 | -------------------------------------------------------------------------------- /eg/benchmarks/simple: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl -w 2 | ########################################### 3 | # Log4perl Benchmarks 4 | # Mike Schilli, 2008 (m@perlmeister.com) 5 | ########################################### 6 | use strict; 7 | use Benchmark qw(timeit timestr); 8 | use Log::Log4perl qw(:easy); 9 | use Sysadm::Install qw(:all); 10 | use Data::Dumper; 11 | use File::Temp qw(tempfile); 12 | 13 | my($tmp_fh, $tmp_file) = tempfile( UNLINK => 1 ); 14 | 15 | my $nof_tests = 100000; 16 | 17 | print "sp=suppressed w=watch sc=subcategory\n\n"; 18 | 19 | for my $watch (0, 1) { 20 | test_init({ level => "DEBUG", watch => $watch }); 21 | run("sp0 sc0 w$watch", \&debug_logger); 22 | 23 | test_init({ level => "ERROR", watch => $watch }); 24 | run("sp1 sc0 w$watch", \&debug_logger); 25 | 26 | test_init({ level => "DEBUG", watch => $watch }); 27 | run("sp0 sc1 w$watch", \&subcat_logger); 28 | 29 | test_init({ level => "ERROR", watch => $watch }); 30 | run("sp1 sc1 w$watch", \&subcat_logger); 31 | } 32 | 33 | ########################################### 34 | sub run { 35 | ########################################### 36 | my($name, $sub) = @_; 37 | 38 | my $t = timeit(1, $sub); 39 | printf "$name: %8.0f per sec\n", $nof_tests/$t->[1]; 40 | } 41 | 42 | ########################################### 43 | sub test_init { 44 | ########################################### 45 | my($opts) = @_; 46 | 47 | my $conf = qq{ 48 | log4perl.logger = $opts->{level}, testapp 49 | log4perl.appender.testapp = Log::Log4perl::Appender::TestBuffer 50 | log4perl.appender.testapp.layout= SimpleLayout 51 | }; 52 | 53 | if($opts->{watch}) { 54 | blurt $conf, $tmp_file; 55 | Log::Log4perl->init_and_watch( $tmp_file ); 56 | } else { 57 | Log::Log4perl->init( \$conf ); 58 | } 59 | } 60 | 61 | ########################################### 62 | sub debug_logger { 63 | ########################################### 64 | my $logger = get_logger(""); 65 | 66 | for(1..$nof_tests) { 67 | $logger->debug( "message" ); 68 | } 69 | } 70 | 71 | ########################################### 72 | sub subcat_logger { 73 | ########################################### 74 | my $logger = get_logger("a.b.c.d.e.f.g.h.i.j.k"); 75 | 76 | for(1..$nof_tests) { 77 | $logger->debug( "message" ); 78 | } 79 | } 80 | -------------------------------------------------------------------------------- /eg/color: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | ###################################################################### 3 | # color - Print messages colored by level 4 | ###################################################################### 5 | use strict; 6 | use warnings; 7 | 8 | my $VERSION = "0.01"; 9 | our $CVSVERSION = '$Revision: 1.1 $'; 10 | 11 | use Log::Log4perl qw(:easy); 12 | Log::Log4perl->init(\ <<'EOT'); 13 | log4perl.category = DEBUG, Screen 14 | log4perl.appender.Screen = Log::Log4perl::Appender::ScreenColoredLevels 15 | log4perl.appender.Screen.layout = \ 16 | Log::Log4perl::Layout::PatternLayout 17 | log4perl.appender.Screen.layout.ConversionPattern = %d %F{1} %L> %m %n 18 | EOT 19 | 20 | for(1..3) { 21 | DEBUG "Debug Message"; 22 | INFO "Info Message"; 23 | WARN "Warn Message"; 24 | ERROR "Error Message"; 25 | FATAL "Fatal Message"; 26 | } 27 | -------------------------------------------------------------------------------- /eg/dupe-warning.conf: -------------------------------------------------------------------------------- 1 | log4perl.category = WARN, Logfile 2 | log4perl.appender.Logfile = Log::Log4perl::Appender::File 3 | log4perl.appender.Logfile.filename = test.log 4 | log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout 5 | log4perl.appender.Logfile.layout.ConversionPattern = %d %F{1} %L> %m %n 6 | 7 | log4perl.category = TRACE, Logfile 8 | -------------------------------------------------------------------------------- /eg/jabber.conf: -------------------------------------------------------------------------------- 1 | #here's an example of using Log::Dispatch::Jabber 2 | 3 | log4j.category.animal.dog = INFO, jabbender 4 | 5 | log4j.appender.jabbender = Log::Dispatch::Jabber 6 | log4j.appender.jabbender.layout = Log::Log4perl::Layout::SimpleLayout 7 | log4j.appender.jabbender.login.hostname = a.jabber.server 8 | log4j.appender.jabbender.login.port = 5222 9 | log4j.appender.jabbender.login.username = ***** 10 | log4j.appender.jabbender.login.password = ********** 11 | log4j.appender.jabbender.login.resource = logger 12 | log4j.appender.jabbender.to = *****@a.jabber.server 13 | log4j.appender.jabbender.to = ******@another.jabber.server 14 | 15 | -------------------------------------------------------------------------------- /eg/l4p-tmpl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | ########################################### 3 | # l4p-tmpl 4 | # 2009, Mike Schilli 5 | ########################################### 6 | use strict; 7 | use warnings; 8 | 9 | print <<'EOT'; 10 | log4perl.category = WARN, Logfile 11 | log4perl.appender.Logfile = Log::Log4perl::Appender::File 12 | log4perl.appender.Logfile.filename = test.log 13 | log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout 14 | log4perl.appender.Logfile.layout.ConversionPattern = %d %F{1} %L> %m %n 15 | EOT 16 | 17 | __END__ 18 | 19 | =head1 NAME 20 | 21 | l4p-tmpl - Print out a Log4perl template configuration 22 | 23 | =head1 SYNOPSIS 24 | 25 | l4p-tmpl >l4p.conf 26 | 27 | =head1 DESCRIPTION 28 | 29 | l4p-tmpl prints out the text of a template Log4perl configuration for 30 | starting a new Log4perl configuration file. 31 | 32 | =head1 LICENSE 33 | 34 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 35 | and Kevin Goess Ecpan@goess.orgE. 36 | 37 | This library is free software; you can redistribute it and/or modify 38 | it under the same terms as Perl itself. 39 | 40 | =head1 AUTHOR 41 | 42 | Please contribute patches to the project on Github: 43 | 44 | http://github.com/mschilli/log4perl 45 | 46 | Send bug reports or requests for enhancements to the authors via our 47 | 48 | MAILING LIST (questions, bug reports, suggestions/patches): 49 | log4perl-devel@lists.sourceforge.net 50 | 51 | Authors (please contact them via the list above, not directly): 52 | Mike Schilli , 53 | Kevin Goess 54 | 55 | Contributors (in alphabetical order): 56 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 57 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 58 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 59 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 60 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 61 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 62 | Lars Thegler, David Viner, Mac Yang. 63 | 64 | -------------------------------------------------------------------------------- /eg/log4j-file-append-java.conf: -------------------------------------------------------------------------------- 1 | ############################################################ 2 | # A simple root logger with a FileAppender file appender 3 | # in Java (ultimately maps to Log::Dispatch::File). 4 | # Mike Schilli 2002 m@perlmeister.com 5 | ############################################################ 6 | log4j.rootLogger=DEBUG, LOGFILE 7 | 8 | log4j.appender.LOGFILE=org.apache.log4j.FileAppender 9 | log4j.appender.LOGFILE.File=example-java.log 10 | 11 | log4j.appender.LOGFILE.layout=org.apache.log4j.PatternLayout 12 | log4j.appender.LOGFILE.layout.ConversionPattern=%F %L %p %t %c - %m%n 13 | -------------------------------------------------------------------------------- /eg/log4j-file-append-perl.conf: -------------------------------------------------------------------------------- 1 | ############################################################ 2 | # A simple root logger with a Log::Dispatch file appender 3 | # in Perl. 4 | # Mike Schilli 2002 m@perlmeister.com 5 | ############################################################ 6 | log4j.rootLogger=DEBUG, LOGFILE 7 | 8 | log4j.appender.LOGFILE=Log::Log4perl::Appender::File 9 | log4j.appender.LOGFILE.filename=example-perl.log 10 | log4j.appender.LOGFILE.mode=append 11 | 12 | log4j.appender.LOGFILE.layout=org.apache.log4j.PatternLayout 13 | log4j.appender.LOGFILE.layout.ConversionPattern=%F{1} %L %p %t %c - %m%n 14 | -------------------------------------------------------------------------------- /eg/log4j-manual-1.conf: -------------------------------------------------------------------------------- 1 | # From the Log4j manual at 2 | # http://jakarta.apache.org/log4j/docs/manual.html 3 | # (Just replaced ConsoleAppender by BufferAppender for testing) 4 | 5 | # Set root logger level to DEBUG and its only appender to A1. 6 | log4j.rootLogger=DEBUG, A1 7 | 8 | # A1 is set to be a BufferAppender (a ConsoleAppender for testing). 9 | log4j.appender.A1=Log::Log4perl::Appender::TestBuffer 10 | 11 | # A1 uses PatternLayout. 12 | log4j.appender.A1.layout=org.apache.log4j.PatternLayout 13 | log4j.appender.A1.layout.ConversionPattern=%-4r [%t] %-5p %c %t - %m%n 14 | -------------------------------------------------------------------------------- /eg/log4j-manual-2.conf: -------------------------------------------------------------------------------- 1 | # From the Log4j manual at 2 | # http://jakarta.apache.org/log4j/docs/manual.html 3 | # (Just replaced ConsoleAppender by BufferAppender for testing) 4 | 5 | log4j.rootLogger=DEBUG, A1 6 | log4j.appender.A1=Log::Log4perl::Appender::TestBuffer 7 | log4j.appender.A1.layout=org.apache.log4j.PatternLayout 8 | 9 | # Print the date in ISO 8601 format 10 | log4j.appender.A1.layout.ConversionPattern=%d [%t] %-5p %c - %m%n 11 | 12 | # Print only messages of level WARN or above in the package com.foo. 13 | log4j.logger.com.foo=WARN 14 | -------------------------------------------------------------------------------- /eg/log4j-manual-3.conf: -------------------------------------------------------------------------------- 1 | # Derived from the Log4j manual at 2 | # http://jakarta.apache.org/log4j/docs/manual.html 3 | 4 | log4j.rootLogger=DEBUG, stdout, R 5 | 6 | log4j.appender.stdout=Log::Log4perl::Appender::TestBuffer 7 | log4j.appender.stdout.layout=org.apache.log4j.PatternLayout 8 | 9 | # Pattern to output the caller's file name and line number. 10 | log4j.appender.stdout.layout.ConversionPattern=%5p [%t] (%F:%L) - %m%n 11 | 12 | log4j.appender.R=Log::Log4perl::Appender::TestBuffer 13 | log4j.appender.R.layout=org.apache.log4j.PatternLayout 14 | log4j.appender.R.layout.ConversionPattern=%p %t '%c' - %m%n 15 | -------------------------------------------------------------------------------- /eg/log4j-utf8.conf: -------------------------------------------------------------------------------- 1 | # Config file with utf8 characters 2 | log4perl.rootLogger=DEBUG, Ä1 3 | log4perl.appender.Ä1=Log::Log4perl::Appender::TestBuffer 4 | log4perl.appender.Ä1.layout=PatternLayout 5 | log4perl.appender.Ä1.layout.ConversionPattern=%m%n 6 | -------------------------------------------------------------------------------- /eg/newsyslog-test: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl -w 2 | ########################################### 3 | # newsyslog-test 4 | # Mike Schilli, 200t (m@perlmeister.com) 5 | ########################################### 6 | use strict; 7 | use Log::Log4perl qw(:easy); 8 | 9 | # newsyslog configuration: 10 | # /tmp/test.log 666 12 1 * B /tmp/test.pid 30 11 | 12 | my $conf = q{ 13 | log4perl.category = DEBUG, Logfile 14 | log4perl.appender.Logfile = Log::Log4perl::Appender::File 15 | log4perl.appender.Logfile.recreate = 1 16 | log4perl.appender.Logfile.recreate_check_signal = USR1 17 | log4perl.appender.Logfile.recreate_pid_write = /tmp/test.pid 18 | log4perl.appender.Logfile.mode = append 19 | log4perl.appender.Logfile.filename = /tmp/test.log 20 | log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout 21 | log4perl.appender.Logfile.layout.ConversionPattern = %d %F{1} %L> %m%n 22 | }; 23 | 24 | Log::Log4perl->init(\$conf); 25 | 26 | while(1) { 27 | DEBUG "test" x 1000; 28 | system("ls -l /tmp/test.log* | head -2; echo"); 29 | sleep(1); 30 | } 31 | -------------------------------------------------------------------------------- /eg/override_appender: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | ###################################################################### 3 | # override_appender -- 2003, Mike Schilli 4 | ###################################################################### 5 | # Overrided the appender layout after defining it in the conf file. 6 | ###################################################################### 7 | use strict; 8 | use warnings; 9 | 10 | my $VERSION = "0.01"; 11 | our $CVSVERSION = '$Revision: 1.1 $'; 12 | 13 | use Log::Log4perl qw(:easy); 14 | Log::Log4perl->init(\ <<'EOT'); 15 | log4perl.category = WARN, Screen 16 | log4perl.appender.Screen = Log::Log4perl::Appender::Screen 17 | log4perl.appender.Screen.layout = \ 18 | Log::Log4perl::Layout::PatternLayout 19 | log4perl.appender.Screen.layout.ConversionPattern = %d %F{1} %L> %m %n 20 | EOT 21 | 22 | my $appenders = Log::Log4perl->appenders(); 23 | my $layout = Log::Log4perl::Layout::PatternLayout->new("%m %m%n"); 24 | $appenders->{Screen}->layout($layout); 25 | WARN("test message"); 26 | 27 | __END__ 28 | 29 | =head1 NAME 30 | 31 | override_appender - Try to change an appender's layout 32 | 33 | =head1 SYNOPSIS 34 | 35 | override_appender 36 | 37 | =head1 DESCRIPTION 38 | 39 | Change an appender's layout after it has been defined in the configuration 40 | file. 41 | 42 | =head1 LICENSE 43 | 44 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 45 | and Kevin Goess Ecpan@goess.orgE. 46 | 47 | This library is free software; you can redistribute it and/or modify 48 | it under the same terms as Perl itself. 49 | 50 | =head1 AUTHOR 51 | 52 | Please contribute patches to the project on Github: 53 | 54 | http://github.com/mschilli/log4perl 55 | 56 | Send bug reports or requests for enhancements to the authors via our 57 | 58 | MAILING LIST (questions, bug reports, suggestions/patches): 59 | log4perl-devel@lists.sourceforge.net 60 | 61 | Authors (please contact them via the list above, not directly): 62 | Mike Schilli , 63 | Kevin Goess 64 | 65 | Contributors (in alphabetical order): 66 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 67 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 68 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 69 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 70 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 71 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 72 | Lars Thegler, David Viner, Mac Yang. 73 | 74 | -------------------------------------------------------------------------------- /eg/prototype: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | ########################################### 3 | # prototype -- use a Class::Prototyped appender 4 | # Mike Schilli, 2004 (m@perlmeister.com) 5 | ########################################### 6 | use warnings; 7 | use strict; 8 | 9 | use Class::Prototyped; 10 | 11 | my $class = Class::Prototyped->newPackage( 12 | "MyAppenders::Bulletizer", 13 | bullets => 1, 14 | log => sub { 15 | my($self, %params) = @_; 16 | print "*" x $self->bullets(), 17 | $params{message}; 18 | }, 19 | ); 20 | 21 | use Log::Log4perl qw(:easy); 22 | 23 | Log::Log4perl->init(\ q{ 24 | log4perl.logger = INFO, Bully 25 | 26 | log4perl.appender.Bully=MyAppenders::Bulletizer 27 | log4perl.appender.Bully.bullets=3 28 | 29 | log4perl.appender.Bully.layout = PatternLayout 30 | log4perl.appender.Bully.layout.ConversionPattern=%m %n 31 | }); 32 | 33 | # ... prints: "***Boo!\n"; 34 | INFO "Boo!"; 35 | -------------------------------------------------------------------------------- /eg/syslog.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | ########################################### 3 | # Syslog test cases 4 | # Kevin Goess, cpan@goess.org 2002 5 | ########################################### 6 | use warnings; 7 | use strict; 8 | 9 | use Log::Log4perl; 10 | use Test; 11 | 12 | our $RESULT_BUFFER; 13 | 14 | package Log::MyOwnAppender; 15 | 16 | our $IS_LOADED = 1; 17 | 18 | use base qw(Log::Dispatch::Output); 19 | 20 | sub new { 21 | my($proto, %params) = @_; 22 | my $class = ref $proto || $proto; 23 | 24 | my $self = bless {}, $class; 25 | 26 | $self->_basic_init(%params); 27 | 28 | return $self; 29 | } 30 | 31 | 32 | sub log_message { 33 | my $self = shift; 34 | my %params = @_; 35 | 36 | #params is { name => \$appender_name, 37 | # level => 0, 38 | # message => \$message, 39 | 40 | $main::RESULT_BUFFER = $params{level}; 41 | } 42 | 43 | 44 | package main; 45 | 46 | 47 | my $config = <fatal('foo'); 65 | ok($RESULT_BUFFER, 7); 66 | $RESULT_BUFFER = undef; 67 | 68 | $logger->error('foo'); 69 | ok($RESULT_BUFFER, 4); 70 | $RESULT_BUFFER = undef; 71 | 72 | $logger->warn('foo'); 73 | ok($RESULT_BUFFER, 3); 74 | $RESULT_BUFFER = undef; 75 | 76 | $logger->info('foo'); 77 | ok($RESULT_BUFFER, 1); 78 | $RESULT_BUFFER = undef; 79 | 80 | $logger->debug('foo'); 81 | ok($RESULT_BUFFER, 0); 82 | $RESULT_BUFFER = undef; 83 | 84 | 85 | 86 | BEGIN { plan tests => 5, } 87 | -------------------------------------------------------------------------------- /eg/yamlparser: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | ########################################### 3 | # yamlparser 4 | # Mike Schilli, 2004 (m@perlmeister.com) 5 | ########################################### 6 | use warnings; 7 | use strict; 8 | 9 | package MyYAMLParser; 10 | use base qw(Log::Log4perl::Config::BaseConfigurator); 11 | use YAML qw(LoadFile Load); 12 | use Data::Dumper; 13 | 14 | ########################################### 15 | sub new { 16 | ########################################### 17 | my($class, %options) = @_; 18 | 19 | my $self = {}; 20 | 21 | bless $self, $class; 22 | 23 | $self->{text} = $options{text} if exists $options{text}; 24 | $self->{file} = $options{file} if exists $options{file}; 25 | 26 | if(! exists $self->{text} and 27 | ! exists $self->{file}) { 28 | die "usage: ", __PACKAGE__, "->new(file => \$filename) or ", 29 | __PACKAGE__, "->new(text => \$text)"; 30 | } 31 | 32 | return $self; 33 | } 34 | 35 | ########################################### 36 | sub parse { 37 | ########################################### 38 | my($self) = @_; 39 | 40 | my $data = {}; 41 | 42 | if(exists $self->{text}) { 43 | $self->{data} = Load($self->{text}); 44 | } 45 | 46 | # Move all non-hash values under {...}->{value} 47 | my @todo = ($self->{data}); 48 | 49 | while (@todo) { 50 | my $ref = shift @todo; 51 | for (keys %$ref) { 52 | if(ref($ref->{$_}) eq "HASH") { 53 | push @todo, $ref->{$_}; 54 | } elsif($_ eq "name") { 55 | # Appender 'name' entries are 56 | # converted to ->{value} entries 57 | $ref->{value} = $ref->{$_}; 58 | delete $ref->{$_}; 59 | } else { 60 | my $tmp = $ref->{$_}; 61 | $ref->{$_} = {}; 62 | $ref->{$_}->{value} = $tmp; 63 | } 64 | } 65 | } 66 | 67 | return $self->{data}; 68 | } 69 | 70 | package main; 71 | 72 | use Log::Log4perl; 73 | 74 | my $p = MyYAMLParser->new(text => <parse()); 89 | 90 | Log::Log4perl->init($p); 91 | 92 | my $log = Log::Log4perl->get_logger("Bar::Twix"); 93 | $log->warn('foo'); 94 | -------------------------------------------------------------------------------- /ldap/log4perl-2.ldif: -------------------------------------------------------------------------------- 1 | # objectclass ( myobjs:3 2 | # NAME 'log4perlAppender' 3 | # SUP top 4 | # STRUCTURAL 5 | # DESC 'A log4perl Appender' 6 | # MUST ( name $ log4perlClass $ log4perlLayout) 7 | # MAY ( log4perlParam ) 8 | # ) 9 | # 10 | # objectclass ( myobjs:6 11 | # NAME 'log4perlFileAppender' 12 | # SUP top 13 | # AUXILIARY 14 | # DESC 'appends to a file' 15 | # MUST ( log4perlfilename $ log4perlmode 16 | # $log4perlautoflush) 17 | # 18 | # ) 19 | # 20 | # 21 | # objectclass ( myobjs:7 22 | # NAME 'log4perlParam' 23 | # SUP top 24 | # AUXILIARY 25 | # DESC 'a name/value tuple' 26 | # MUST ( name $ log4perlvalue ) 27 | # 28 | # ) 29 | 30 | 31 | #Method 1 32 | #using auxiliary classes 33 | dn: name=FileAppender1,dc=testsystem,dc=log4perl,dc=goess,dc=org 34 | objectclass: log4perlAppender 35 | objectclass: log4perlFileAppender 36 | name:FileAppender1 37 | log4perlClass:Log::Log4perl::Appender::File 38 | log4perlLayout:name=Layout1,dc=testsystem,dc=log4perl,dc=goess,dc=org 39 | log4perlfilename:/var/log/testfile 40 | log4perlmode:append 41 | log4perlautoflush:1 42 | 43 | #Method 2 44 | #using log4perlParam classes 45 | dn: name=OtherFileAppndr, dc=testsystem,dc=log4perl,dc=goess,dc=org 46 | objectclass: log4perlAppender 47 | name:OtherFileAppndr 48 | log4perlClass:Log::Log4perl::Appender::File 49 | log4perlLayout:name=Layout1,dc=testsystem,dc=log4perl,dc=goess,dc=org 50 | log4perlParam:name=filename,name=OtherFileAppndr,dc=testsystem,dc=log4perl,dc=goess,dc=org 51 | log4perlParam:name=mode,name=OtherFileAppndr,dc=testsystem,dc=log4perl,dc=goess,dc=org 52 | log4perlParam:name=autoflush,name=OtherFileAppndr,dc=testsystem,dc=log4perl,dc=goess,dc=org 53 | 54 | dn: name=filename,name=OtherFileAppndr,dc=testsystem,dc=log4perl,dc=goess,dc=org 55 | objectclass: log4perlParam 56 | name:filename 57 | log4perlvalue:/var/log/testfile 58 | 59 | dn: name=mode,name=OtherFileAppndr,dc=testsystem,dc=log4perl,dc=goess,dc=org 60 | objectclass: log4perlParam 61 | name:mode 62 | log4perlvalue:append 63 | 64 | dn: name=autoflush,name=OtherFileAppndr,dc=testsystem,dc=log4perl,dc=goess,dc=org 65 | objectclass: log4perlParam 66 | name:autoflush 67 | log4perlvalue:1 68 | 69 | 70 | 71 | -------------------------------------------------------------------------------- /ldap/log4perl-unittest.ldif: -------------------------------------------------------------------------------- 1 | # objectclass ( myobjs:3 2 | # NAME 'log4perlAppender' 3 | # SUP top 4 | # STRUCTURAL 5 | # DESC 'A log4perl Appender' 6 | # MUST ( name $ log4perlClass $ log4perlLayout) 7 | # MAY ( log4perlParam ) 8 | # ) 9 | # 10 | # objectclass ( myobjs:6 11 | # NAME 'log4perlFileAppender' 12 | # SUP top 13 | # AUXILIARY 14 | # DESC 'appends to a file' 15 | # MUST ( log4perlfilename $ log4perlmode 16 | # $log4perlautoflush) 17 | # 18 | # ) 19 | # 20 | # 21 | # objectclass ( myobjs:7 22 | # NAME 'log4perlParam' 23 | # SUP top 24 | # AUXILIARY 25 | # DESC 'a name/value tuple' 26 | # MUST ( name $ log4perlvalue ) 27 | # 28 | # ) 29 | 30 | 31 | dn: name=A1,dc=testsystem,dc=log4perl,dc=goess,dc=org 32 | objectclass: log4perlAppender 33 | name:A1 34 | log4perlClass: Log::Log4perl::Appender::TestBuffer 35 | log4perlLayoutClass: Log::Log4perl::Layout::SimpleLayout 36 | 37 | dn: name=A2,dc=testsystem,dc=log4perl,dc=goess,dc=org 38 | objectclass: log4perlAppender 39 | name:A2 40 | log4perlClass: Log::Log4perl::Appender::TestBuffer 41 | log4perlLayoutClass: Log::Log4perl::Layout::SimpleLayout 42 | 43 | -------------------------------------------------------------------------------- /ldap/migrate.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | # 3 | # This was adapted from a script on the redhat-ds wiki, 4 | # it now at least attempts to handle openldap's "objectidentifier" 5 | # macros --Kevin Goess 12/2005 6 | # 7 | # this is a quick perl script to convert OpenLDAP schema files 8 | # to FDS ldif (schema) files. it is probably not anywhere near 9 | # useful, but it did allow me to convert a few of my .schema 10 | # files and have FDS successfully start with them. 11 | # 12 | # -Nathan Benson 13 | # 14 | 15 | use strict; 16 | 17 | die "usage: $0 \n" unless my $file = $ARGV[0]; 18 | die "$! '$file'\n" unless -e $file; 19 | 20 | my $start; 21 | 22 | print "dn: cn=schema\n"; 23 | 24 | my (%objectidentifier, $objidmatch); 25 | 26 | open SCHEMA, $file; 27 | while () 28 | { 29 | next if /^(#|$)/; 30 | 31 | #see http://www.openldap.org/doc/admin22/schema.html#OID%20Macros 32 | if ($objidmatch && /($objidmatch:| $objidmatch )/) 33 | { 34 | s/($objidmatch):/$objectidentifier{$1}./; 35 | 36 | #boo, this doesn't work for stuff in quoted fields 37 | s/\s($objidmatch)\s/ $objectidentifier{$1} / unless /DESC/; 38 | } 39 | 40 | if (/^\s*objectidentifier\s+(\S+)\s+(\S+)/) 41 | { 42 | $objectidentifier{$1} = $2; 43 | $objidmatch = join('|',keys(%objectidentifier)); 44 | } 45 | 46 | 47 | if (/^(objectclass|attributetype)\s/i) 48 | { 49 | print "\n" if ($start); 50 | chomp; 51 | 52 | 53 | $_ =~ s/^objectclass/objectclasses:/i; 54 | $_ =~ s/^attributetype/attributetypes:/i; 55 | $_ =~ s/(\t|\s)/ /; 56 | 57 | 58 | $start = 1; 59 | print; 60 | } 61 | elsif ((/^\s*\w/) && ($start)) 62 | { 63 | chomp; 64 | $_ =~ s/^(\s*)/ /; 65 | print; 66 | } 67 | elsif (/^\s*\)\s*$/ && $start) { 68 | print ')'; 69 | } 70 | } 71 | close SCHEMA; 72 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/Appender/String.pm: -------------------------------------------------------------------------------- 1 | package Log::Log4perl::Appender::String; 2 | our @ISA = qw(Log::Log4perl::Appender); 3 | 4 | ################################################## 5 | # Log dispatcher writing to a string buffer 6 | ################################################## 7 | 8 | ################################################## 9 | sub new { 10 | ################################################## 11 | my $proto = shift; 12 | my $class = ref $proto || $proto; 13 | my %params = @_; 14 | 15 | my $self = { 16 | name => "unknown name", 17 | string => "", 18 | %params, 19 | }; 20 | 21 | bless $self, $class; 22 | } 23 | 24 | ################################################## 25 | sub log { 26 | ################################################## 27 | my $self = shift; 28 | my %params = @_; 29 | 30 | $self->{string} .= $params{message}; 31 | } 32 | 33 | ################################################## 34 | sub string { 35 | ################################################## 36 | my($self, $new) = @_; 37 | 38 | if(defined $new) { 39 | $self->{string} = $new; 40 | } 41 | 42 | return $self->{string}; 43 | } 44 | 45 | 1; 46 | 47 | __END__ 48 | 49 | =encoding utf8 50 | 51 | =head1 NAME 52 | 53 | Log::Log4perl::Appender::String - Append to a string 54 | 55 | =head1 SYNOPSIS 56 | 57 | use Log::Log4perl::Appender::String; 58 | 59 | my $appender = Log::Log4perl::Appender::String->new( 60 | name => 'my string appender', 61 | ); 62 | 63 | # Append to the string 64 | $appender->log( 65 | message => "I'm searching the city for sci-fi wasabi\n" 66 | ); 67 | 68 | # Retrieve the result 69 | my $result = $appender->string(); 70 | 71 | # Reset the buffer to the empty string 72 | $appender->string(""); 73 | 74 | =head1 DESCRIPTION 75 | 76 | This is a simple appender used internally by C. It 77 | appends messages to a scalar instance variable. 78 | 79 | =head1 LICENSE 80 | 81 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 82 | and Kevin Goess Ecpan@goess.orgE. 83 | 84 | This library is free software; you can redistribute it and/or modify 85 | it under the same terms as Perl itself. 86 | 87 | =head1 AUTHOR 88 | 89 | Please contribute patches to the project on Github: 90 | 91 | http://github.com/mschilli/log4perl 92 | 93 | Send bug reports or requests for enhancements to the authors via our 94 | 95 | MAILING LIST (questions, bug reports, suggestions/patches): 96 | log4perl-devel@lists.sourceforge.net 97 | 98 | Authors (please contact them via the list above, not directly): 99 | Mike Schilli , 100 | Kevin Goess 101 | 102 | Contributors (in alphabetical order): 103 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 104 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 105 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 106 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 107 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 108 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 109 | Lars Thegler, David Viner, Mac Yang. 110 | 111 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/Appender/TestArrayBuffer.pm: -------------------------------------------------------------------------------- 1 | ################################################## 2 | package Log::Log4perl::Appender::TestArrayBuffer; 3 | ################################################## 4 | # Like Log::Log4perl::Appender::TestBuffer, just with 5 | # array capability. 6 | # For testing only. 7 | ################################################## 8 | 9 | use base qw( Log::Log4perl::Appender::TestBuffer ); 10 | 11 | ################################################## 12 | sub log { 13 | ################################################## 14 | my $self = shift; 15 | my %params = @_; 16 | 17 | $self->{buffer} .= "[$params{level}]: " if $LOG_PRIORITY; 18 | 19 | if(ref($params{message}) eq "ARRAY") { 20 | $self->{buffer} .= "[" . join(',', @{$params{message}}) . "]"; 21 | } else { 22 | $self->{buffer} .= $params{message}; 23 | } 24 | } 25 | 26 | 1; 27 | 28 | =encoding utf8 29 | 30 | =head1 NAME 31 | 32 | Log::Log4perl::Appender::TestArrayBuffer - Subclass of Appender::TestBuffer 33 | 34 | =head1 SYNOPSIS 35 | 36 | use Log::Log4perl::Appender::TestArrayBuffer; 37 | 38 | my $appender = Log::Log4perl::Appender::TestArrayBuffer->new( 39 | name => 'buffer', 40 | ); 41 | 42 | # Append to the buffer 43 | $appender->log( 44 | level = > 'alert', 45 | message => ['first', 'second', 'third'], 46 | ); 47 | 48 | # Retrieve the result 49 | my $result = $appender->buffer(); 50 | 51 | # Reset the buffer to the empty string 52 | $appender->reset(); 53 | 54 | =head1 DESCRIPTION 55 | 56 | This class is a subclass of Log::Log4perl::Appender::TestBuffer and 57 | just provides message array refs as an additional feature. 58 | 59 | Just like Log::Log4perl::Appender::TestBuffer, 60 | Log::Log4perl::Appender::TestArrayBuffer is used for internal 61 | Log::Log4perl testing only. 62 | 63 | =head1 LICENSE 64 | 65 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 66 | and Kevin Goess Ecpan@goess.orgE. 67 | 68 | This library is free software; you can redistribute it and/or modify 69 | it under the same terms as Perl itself. 70 | 71 | =head1 AUTHOR 72 | 73 | Please contribute patches to the project on Github: 74 | 75 | http://github.com/mschilli/log4perl 76 | 77 | Send bug reports or requests for enhancements to the authors via our 78 | 79 | MAILING LIST (questions, bug reports, suggestions/patches): 80 | log4perl-devel@lists.sourceforge.net 81 | 82 | Authors (please contact them via the list above, not directly): 83 | Mike Schilli , 84 | Kevin Goess 85 | 86 | Contributors (in alphabetical order): 87 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 88 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 89 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 90 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 91 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 92 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 93 | Lars Thegler, David Viner, Mac Yang. 94 | 95 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/Appender/TestFileCreeper.pm: -------------------------------------------------------------------------------- 1 | ################################################## 2 | package Log::Log4perl::Appender::TestFileCreeper; 3 | ################################################## 4 | # Test appender, intentionally slow. It writes 5 | # out one byte at a time to provoke sync errors. 6 | # Don't use it, unless for testing. 7 | ################################################## 8 | 9 | use warnings; 10 | use strict; 11 | 12 | use Log::Log4perl::Appender::File; 13 | 14 | our @ISA = qw(Log::Log4perl::Appender::File); 15 | 16 | ################################################## 17 | sub log { 18 | ################################################## 19 | my($self, %params) = @_; 20 | 21 | my $fh = $self->{fh}; 22 | 23 | for (split //, $params{message}) { 24 | print $fh $_; 25 | my $oldfh = select $self->{fh}; 26 | $| = 1; 27 | select $oldfh; 28 | } 29 | } 30 | 31 | 1; 32 | 33 | __END__ 34 | 35 | =encoding utf8 36 | 37 | =head1 NAME 38 | 39 | Log::Log4perl::Appender::TestFileCreeper - Intentionally slow test appender 40 | 41 | =head1 SYNOPSIS 42 | 43 | use Log::Log4perl::Appender::TestFileCreeper; 44 | 45 | my $app = Log::Log4perl::Appender::TestFileCreeper->new( 46 | filename => 'file.log', 47 | mode => 'append', 48 | ); 49 | 50 | $file->log(message => "Log me\n"); 51 | 52 | =head1 DESCRIPTION 53 | 54 | This is a test appender, and it is intentionally slow. It writes 55 | out one byte at a time to provoke sync errors. Don't use it, unless 56 | for testing. 57 | 58 | =head1 LICENSE 59 | 60 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 61 | and Kevin Goess Ecpan@goess.orgE. 62 | 63 | This library is free software; you can redistribute it and/or modify 64 | it under the same terms as Perl itself. 65 | 66 | =head1 AUTHOR 67 | 68 | Please contribute patches to the project on Github: 69 | 70 | http://github.com/mschilli/log4perl 71 | 72 | Send bug reports or requests for enhancements to the authors via our 73 | 74 | MAILING LIST (questions, bug reports, suggestions/patches): 75 | log4perl-devel@lists.sourceforge.net 76 | 77 | Authors (please contact them via the list above, not directly): 78 | Mike Schilli , 79 | Kevin Goess 80 | 81 | Contributors (in alphabetical order): 82 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 83 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 84 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 85 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 86 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 87 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 88 | Lars Thegler, David Viner, Mac Yang. 89 | 90 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/Filter/LevelMatch.pm: -------------------------------------------------------------------------------- 1 | ################################################## 2 | package Log::Log4perl::Filter::LevelMatch; 3 | ################################################## 4 | 5 | use 5.006; 6 | 7 | use strict; 8 | use warnings; 9 | 10 | use Log::Log4perl::Level; 11 | use Log::Log4perl::Config; 12 | use Log::Log4perl::Util qw( params_check ); 13 | 14 | use constant _INTERNAL_DEBUG => 0; 15 | 16 | use base qw(Log::Log4perl::Filter); 17 | 18 | ################################################## 19 | sub new { 20 | ################################################## 21 | my ($class, %options) = @_; 22 | 23 | my $self = { LevelToMatch => '', 24 | AcceptOnMatch => 1, 25 | %options, 26 | }; 27 | 28 | params_check( $self, 29 | [ qw( LevelToMatch ) ], 30 | [ qw( name AcceptOnMatch ) ] 31 | ); 32 | 33 | $self->{AcceptOnMatch} = Log::Log4perl::Config::boolean_to_perlish( 34 | $self->{AcceptOnMatch}); 35 | 36 | bless $self, $class; 37 | 38 | return $self; 39 | } 40 | 41 | ################################################## 42 | sub ok { 43 | ################################################## 44 | my ($self, %p) = @_; 45 | 46 | if($self->{LevelToMatch} eq $p{log4p_level}) { 47 | print "Levels match\n" if _INTERNAL_DEBUG; 48 | return $self->{AcceptOnMatch}; 49 | } else { 50 | print "Levels don't match\n" if _INTERNAL_DEBUG; 51 | return !$self->{AcceptOnMatch}; 52 | } 53 | } 54 | 55 | 1; 56 | 57 | __END__ 58 | 59 | =encoding utf8 60 | 61 | =head1 NAME 62 | 63 | Log::Log4perl::Filter::LevelMatch - Filter to match the log level exactly 64 | 65 | =head1 SYNOPSIS 66 | 67 | log4perl.filter.Match1 = Log::Log4perl::Filter::LevelMatch 68 | log4perl.filter.Match1.LevelToMatch = ERROR 69 | log4perl.filter.Match1.AcceptOnMatch = true 70 | 71 | =head1 DESCRIPTION 72 | 73 | This Log4perl custom filter checks if the currently submitted message 74 | matches a predefined priority, as set in C. 75 | The additional parameter C defines if the filter 76 | is supposed to pass or block the message (C or C) 77 | on a match. 78 | 79 | =head1 SEE ALSO 80 | 81 | L, 82 | L, 83 | L, 84 | L, 85 | L 86 | 87 | =head1 LICENSE 88 | 89 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 90 | and Kevin Goess Ecpan@goess.orgE. 91 | 92 | This library is free software; you can redistribute it and/or modify 93 | it under the same terms as Perl itself. 94 | 95 | =head1 AUTHOR 96 | 97 | Please contribute patches to the project on Github: 98 | 99 | http://github.com/mschilli/log4perl 100 | 101 | Send bug reports or requests for enhancements to the authors via our 102 | 103 | MAILING LIST (questions, bug reports, suggestions/patches): 104 | log4perl-devel@lists.sourceforge.net 105 | 106 | Authors (please contact them via the list above, not directly): 107 | Mike Schilli , 108 | Kevin Goess 109 | 110 | Contributors (in alphabetical order): 111 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 112 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 113 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 114 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 115 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 116 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 117 | Lars Thegler, David Viner, Mac Yang. 118 | 119 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/Filter/LevelRange.pm: -------------------------------------------------------------------------------- 1 | ################################################## 2 | package Log::Log4perl::Filter::LevelRange; 3 | ################################################## 4 | 5 | use 5.006; 6 | 7 | use strict; 8 | use warnings; 9 | 10 | use Log::Log4perl::Level; 11 | use Log::Log4perl::Config; 12 | use Log::Log4perl::Util qw( params_check ); 13 | 14 | use constant _INTERNAL_DEBUG => 0; 15 | 16 | use base "Log::Log4perl::Filter"; 17 | 18 | ################################################## 19 | sub new { 20 | ################################################## 21 | my ($class, %options) = @_; 22 | 23 | my $self = { LevelMin => 'DEBUG', 24 | LevelMax => 'FATAL', 25 | AcceptOnMatch => 1, 26 | %options, 27 | }; 28 | 29 | params_check( $self, 30 | [ qw( LevelMin LevelMax ) ], 31 | [ qw( name AcceptOnMatch ) ] 32 | ); 33 | 34 | $self->{AcceptOnMatch} = Log::Log4perl::Config::boolean_to_perlish( 35 | $self->{AcceptOnMatch}); 36 | 37 | bless $self, $class; 38 | 39 | return $self; 40 | } 41 | 42 | ################################################## 43 | sub ok { 44 | ################################################## 45 | my ($self, %p) = @_; 46 | 47 | if(Log::Log4perl::Level::to_priority($self->{LevelMin}) <= 48 | Log::Log4perl::Level::to_priority($p{log4p_level}) and 49 | Log::Log4perl::Level::to_priority($self->{LevelMax}) >= 50 | Log::Log4perl::Level::to_priority($p{log4p_level})) { 51 | return $self->{AcceptOnMatch}; 52 | } else { 53 | return ! $self->{AcceptOnMatch}; 54 | } 55 | } 56 | 57 | 1; 58 | 59 | __END__ 60 | 61 | =encoding utf8 62 | 63 | =head1 NAME 64 | 65 | Log::Log4perl::Filter::LevelRange - Filter for a range of log levels 66 | 67 | =head1 SYNOPSIS 68 | 69 | log4perl.filter.Match1 = Log::Log4perl::Filter::LevelRange 70 | log4perl.filter.Match1.LevelMin = INFO 71 | log4perl.filter.Match1.LevelMax = ERROR 72 | log4perl.filter.Match1.AcceptOnMatch = true 73 | 74 | =head1 DESCRIPTION 75 | 76 | This Log4perl custom filter checks if the current message 77 | has a priority matching a predefined range. 78 | The C and C parameters define the levels 79 | (choose from C, C, C, C, C) marking 80 | the window of allowed messages priorities. 81 | 82 | C defaults to C, and C to C. 83 | 84 | The additional parameter C defines if the filter 85 | is supposed to pass or block the message (C or C). 86 | 87 | =head1 SEE ALSO 88 | 89 | L, 90 | L, 91 | L, 92 | L, 93 | L 94 | 95 | =head1 LICENSE 96 | 97 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 98 | and Kevin Goess Ecpan@goess.orgE. 99 | 100 | This library is free software; you can redistribute it and/or modify 101 | it under the same terms as Perl itself. 102 | 103 | =head1 AUTHOR 104 | 105 | Please contribute patches to the project on Github: 106 | 107 | http://github.com/mschilli/log4perl 108 | 109 | Send bug reports or requests for enhancements to the authors via our 110 | 111 | MAILING LIST (questions, bug reports, suggestions/patches): 112 | log4perl-devel@lists.sourceforge.net 113 | 114 | Authors (please contact them via the list above, not directly): 115 | Mike Schilli , 116 | Kevin Goess 117 | 118 | Contributors (in alphabetical order): 119 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 120 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 121 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 122 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 123 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 124 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 125 | Lars Thegler, David Viner, Mac Yang. 126 | 127 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/Filter/MDC.pm: -------------------------------------------------------------------------------- 1 | package Log::Log4perl::Filter::MDC; 2 | use strict; 3 | use warnings; 4 | 5 | use Log::Log4perl::Util qw( params_check ); 6 | 7 | use base "Log::Log4perl::Filter"; 8 | 9 | sub new { 10 | my ( $class, %options ) = @_; 11 | 12 | my $self = {%options}; 13 | 14 | params_check( $self, [qw( KeyToMatch RegexToMatch )] ); 15 | 16 | $self->{RegexToMatch} = qr/$self->{RegexToMatch}/; 17 | 18 | bless $self, $class; 19 | 20 | return $self; 21 | } 22 | 23 | sub ok { 24 | my ( $self, %p ) = @_; 25 | 26 | my $context = Log::Log4perl::MDC->get_context; 27 | 28 | my $value = $context->{ $self->{KeyToMatch} }; 29 | return 1 30 | if defined $value && $value =~ $self->{RegexToMatch}; 31 | 32 | return 0; 33 | } 34 | 35 | 1; 36 | 37 | __END__ 38 | 39 | =encoding utf8 40 | 41 | =head1 NAME 42 | 43 | Log::Log4perl::Filter::MDC - Filter to match on values of a MDC key 44 | 45 | =head1 SYNOPSIS 46 | 47 | log4perl.filter.Match1 = Log::Log4perl::Filter::MDC 48 | log4perl.filter.Match1.KeyToMatch = foo 49 | log4perl.filter.Match1.RegexToMatch = bar 50 | 51 | =head1 DESCRIPTION 52 | 53 | This Log4perl filter checks if a predefined MDC key, as set in C, 54 | of the currently submitted message matches a predefined regex, as set in 55 | C. 56 | 57 | =head1 SEE ALSO 58 | 59 | L, 60 | L, 61 | L, 62 | L, 63 | L, 64 | L 65 | 66 | =head1 LICENSE 67 | 68 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 69 | and Kevin Goess Ecpan@goess.orgE. 70 | 71 | This library is free software; you can redistribute it and/or modify 72 | it under the same terms as Perl itself. 73 | 74 | =head1 AUTHOR 75 | 76 | Please contribute patches to the project on Github: 77 | 78 | http://github.com/mschilli/log4perl 79 | 80 | Send bug reports or requests for enhancements to the authors via our 81 | 82 | MAILING LIST (questions, bug reports, suggestions/patches): 83 | log4perl-devel@lists.sourceforge.net 84 | 85 | Authors (please contact them via the list above, not directly): 86 | Mike Schilli , 87 | Kevin Goess 88 | 89 | Contributors (in alphabetical order): 90 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 91 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 92 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 93 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 94 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 95 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 96 | Lars Thegler, David Viner, Mac Yang. 97 | 98 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/Filter/StringMatch.pm: -------------------------------------------------------------------------------- 1 | ################################################## 2 | package Log::Log4perl::Filter::StringMatch; 3 | ################################################## 4 | 5 | use 5.006; 6 | 7 | use strict; 8 | use warnings; 9 | 10 | use Log::Log4perl::Config; 11 | use Log::Log4perl::Util qw( params_check ); 12 | 13 | use constant _INTERNAL_DEBUG => 0; 14 | 15 | use base "Log::Log4perl::Filter"; 16 | 17 | ################################################## 18 | sub new { 19 | ################################################## 20 | my ($class, %options) = @_; 21 | 22 | print join('-', %options) if _INTERNAL_DEBUG; 23 | 24 | my $self = { StringToMatch => undef, 25 | AcceptOnMatch => 1, 26 | %options, 27 | }; 28 | 29 | params_check( $self, 30 | [ qw( StringToMatch ) ], 31 | [ qw( name AcceptOnMatch ) ] 32 | ); 33 | 34 | $self->{AcceptOnMatch} = Log::Log4perl::Config::boolean_to_perlish( 35 | $self->{AcceptOnMatch}); 36 | 37 | $self->{StringToMatch} = qr($self->{StringToMatch}); 38 | 39 | bless $self, $class; 40 | 41 | return $self; 42 | } 43 | 44 | ################################################## 45 | sub ok { 46 | ################################################## 47 | my ($self, %p) = @_; 48 | 49 | local($_) = join $ 50 | Log::Log4perl::JOIN_MSG_ARRAY_CHAR, @{$p{message}}; 51 | 52 | if($_ =~ $self->{StringToMatch}) { 53 | print "Strings match\n" if _INTERNAL_DEBUG; 54 | return $self->{AcceptOnMatch}; 55 | } else { 56 | print "Strings don't match ($_/$self->{StringToMatch})\n" 57 | if _INTERNAL_DEBUG; 58 | return !$self->{AcceptOnMatch}; 59 | } 60 | } 61 | 62 | 1; 63 | 64 | __END__ 65 | 66 | =encoding utf8 67 | 68 | =head1 NAME 69 | 70 | Log::Log4perl::Filter::StringMatch - Filter on log message string 71 | 72 | =head1 SYNOPSIS 73 | 74 | log4perl.filter.Match1 = Log::Log4perl::Filter::StringMatch 75 | log4perl.filter.Match1.StringToMatch = blah blah 76 | log4perl.filter.Match1.AcceptOnMatch = true 77 | 78 | =head1 DESCRIPTION 79 | 80 | This Log4perl custom filter checks if the currently submitted message 81 | matches a predefined regular expression, as set in the C 82 | parameter. It uses common Perl 5 regexes. 83 | 84 | The additional parameter C defines if the filter 85 | is supposed to pass or block the message on a match (C or C). 86 | 87 | =head1 SEE ALSO 88 | 89 | L, 90 | L, 91 | L, 92 | L, 93 | L 94 | 95 | =head1 LICENSE 96 | 97 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 98 | and Kevin Goess Ecpan@goess.orgE. 99 | 100 | This library is free software; you can redistribute it and/or modify 101 | it under the same terms as Perl itself. 102 | 103 | =head1 AUTHOR 104 | 105 | Please contribute patches to the project on Github: 106 | 107 | http://github.com/mschilli/log4perl 108 | 109 | Send bug reports or requests for enhancements to the authors via our 110 | 111 | MAILING LIST (questions, bug reports, suggestions/patches): 112 | log4perl-devel@lists.sourceforge.net 113 | 114 | Authors (please contact them via the list above, not directly): 115 | Mike Schilli , 116 | Kevin Goess 117 | 118 | Contributors (in alphabetical order): 119 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 120 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 121 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 122 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 123 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 124 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 125 | Lars Thegler, David Viner, Mac Yang. 126 | 127 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/InternalDebug.pm: -------------------------------------------------------------------------------- 1 | package Log::Log4perl::InternalDebug; 2 | use warnings; 3 | use strict; 4 | 5 | use File::Temp qw(tempfile); 6 | use File::Spec; 7 | 8 | require Log::Log4perl::Resurrector; 9 | 10 | ########################################### 11 | sub enable { 12 | ########################################### 13 | unshift @INC, \&internal_debug_loader; 14 | } 15 | 16 | ################################################## 17 | sub internal_debug_fh { 18 | ################################################## 19 | my($file) = @_; 20 | 21 | local($/) = undef; 22 | open FILE, "<$file" or die "Cannot open $file"; 23 | my $text = ; 24 | close FILE; 25 | 26 | my($tmp_fh, $tmpfile) = tempfile( UNLINK => 1 ); 27 | 28 | $text =~ s/_INTERNAL_DEBUG(?!\s*=>)/1/g; 29 | 30 | print $tmp_fh $text; 31 | seek $tmp_fh, 0, 0; 32 | 33 | return $tmp_fh; 34 | } 35 | 36 | ########################################### 37 | sub internal_debug_loader { 38 | ########################################### 39 | my ($code, $module) = @_; 40 | 41 | # Skip non-Log4perl modules 42 | if($module !~ m#^Log/Log4perl#) { 43 | return undef; 44 | } 45 | 46 | my $path = $module; 47 | if(!-f $path) { 48 | $path = Log::Log4perl::Resurrector::pm_search( $module ); 49 | } 50 | 51 | my $fh = internal_debug_fh($path); 52 | 53 | my $abs_path = File::Spec->rel2abs( $path ); 54 | $INC{$module} = $abs_path; 55 | 56 | return $fh; 57 | } 58 | 59 | ########################################### 60 | sub resurrector_init { 61 | ########################################### 62 | unshift @INC, \&resurrector_loader; 63 | } 64 | 65 | ########################################### 66 | sub import { 67 | ########################################### 68 | # enable it on import 69 | enable(); 70 | } 71 | 72 | 1; 73 | 74 | __END__ 75 | 76 | =encoding utf8 77 | 78 | =head1 NAME 79 | 80 | Log::Log4perl::InternalDebug - Dark Magic to enable _INTERNAL_DEBUG 81 | 82 | =head1 DESCRIPTION 83 | 84 | When called with 85 | 86 | perl -MLog::Log4perl::InternalDebug t/001Test.t 87 | 88 | scripts will run with _INTERNAL_DEBUG set to a true value and hence 89 | print internal Log4perl debugging information. 90 | 91 | =head1 LICENSE 92 | 93 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 94 | and Kevin Goess Ecpan@goess.orgE. 95 | 96 | This library is free software; you can redistribute it and/or modify 97 | it under the same terms as Perl itself. 98 | 99 | =head1 AUTHOR 100 | 101 | Please contribute patches to the project on Github: 102 | 103 | http://github.com/mschilli/log4perl 104 | 105 | Send bug reports or requests for enhancements to the authors via our 106 | 107 | MAILING LIST (questions, bug reports, suggestions/patches): 108 | log4perl-devel@lists.sourceforge.net 109 | 110 | Authors (please contact them via the list above, not directly): 111 | Mike Schilli , 112 | Kevin Goess 113 | 114 | Contributors (in alphabetical order): 115 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 116 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 117 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 118 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 119 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 120 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 121 | Lars Thegler, David Viner, Mac Yang. 122 | 123 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/JavaMap/ConsoleAppender.pm: -------------------------------------------------------------------------------- 1 | package Log::Log4perl::JavaMap::ConsoleAppender; 2 | 3 | use Carp; 4 | use strict; 5 | use Log::Dispatch::Screen; 6 | 7 | 8 | sub new { 9 | my ($class, $appender_name, $data) = @_; 10 | my $stderr; 11 | 12 | if (my $t = $data->{Target}{value}) { 13 | if ($t eq 'System.out') { 14 | $stderr = 0; 15 | }elsif ($t eq 'System.err') { 16 | $stderr = 1; 17 | }else{ 18 | die "ERROR: illegal value '$t' for $data->{value}.Target' in appender $appender_name\n"; 19 | } 20 | }elsif (defined $data->{stderr}{value}){ 21 | $stderr = $data->{stderr}{value}; 22 | }else{ 23 | $stderr = 0; 24 | } 25 | 26 | return Log::Log4perl::Appender->new("Log::Dispatch::Screen", 27 | name => $appender_name, 28 | stderr => $stderr ); 29 | } 30 | 31 | 32 | 1; 33 | 34 | 35 | =encoding utf8 36 | 37 | =head1 NAME 38 | 39 | Log::Log4perl::JavaMap::ConsoleAppender - wraps Log::Dispatch::Screen 40 | 41 | =head1 SYNOPSIS 42 | 43 | 44 | =head1 DESCRIPTION 45 | 46 | Possible config properties for log4j ConsoleAppender are 47 | 48 | Target (System.out, System.err, default is System.out) 49 | 50 | Possible config properties for Log::Dispatch::Screen are 51 | 52 | stderr (0 or 1) 53 | 54 | =head1 SEE ALSO 55 | 56 | http://jakarta.apache.org/log4j/docs/ 57 | 58 | Log::Log4perl::Javamap 59 | 60 | Log::Dispatch::Screen 61 | 62 | =cut 63 | 64 | =head1 LICENSE 65 | 66 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 67 | and Kevin Goess Ecpan@goess.orgE. 68 | 69 | This library is free software; you can redistribute it and/or modify 70 | it under the same terms as Perl itself. 71 | 72 | =head1 AUTHOR 73 | 74 | Please contribute patches to the project on Github: 75 | 76 | http://github.com/mschilli/log4perl 77 | 78 | Send bug reports or requests for enhancements to the authors via our 79 | 80 | MAILING LIST (questions, bug reports, suggestions/patches): 81 | log4perl-devel@lists.sourceforge.net 82 | 83 | Authors (please contact them via the list above, not directly): 84 | Mike Schilli , 85 | Kevin Goess 86 | 87 | Contributors (in alphabetical order): 88 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 89 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 90 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 91 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 92 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 93 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 94 | Lars Thegler, David Viner, Mac Yang. 95 | 96 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/JavaMap/FileAppender.pm: -------------------------------------------------------------------------------- 1 | package Log::Log4perl::JavaMap::FileAppender; 2 | 3 | use Carp; 4 | use strict; 5 | use Log::Dispatch::File; 6 | 7 | 8 | sub new { 9 | my ($class, $appender_name, $data) = @_; 10 | my $stderr; 11 | 12 | my $filename = $data->{File}{value} || 13 | $data->{filename}{value} || 14 | die "'File' not supplied for appender '$appender_name', required for a '$data->{value}'\n"; 15 | 16 | my $mode; 17 | if (defined($data->{Append}{value})){ 18 | if (lc $data->{Append}{value} eq 'true' || $data->{Append}{value} == 1){ 19 | $mode = 'append'; 20 | }elsif (lc $data->{Append}{value} eq 'false' || $data->{Append}{value} == 0) { 21 | $mode = 'write'; 22 | }elsif($data->{Append} =~ /^(write|append)$/){ 23 | $mode = $data->{Append} 24 | }else{ 25 | die "'$data->{Append}' is not a legal value for Append for appender '$appender_name', '$data->{value}'\n"; 26 | } 27 | }else{ 28 | $mode = 'append'; 29 | } 30 | 31 | my $autoflush; 32 | if (defined($data->{BufferedIO}{value})){ 33 | if (lc $data->{BufferedIO}{value} eq 'true' || $data->{BufferedIO}{value}){ 34 | $autoflush = 1; 35 | }elsif (lc $data->{BufferedIO}{value} eq 'true' || ! $data->{BufferedIO}{value}) { 36 | $autoflush = 0; 37 | }else{ 38 | die "'$data->{BufferedIO}' is not a legal value for BufferedIO for appender '$appender_name', '$data->{value}'\n"; 39 | } 40 | }else{ 41 | $autoflush = 1; 42 | } 43 | 44 | 45 | return Log::Log4perl::Appender->new("Log::Dispatch::File", 46 | name => $appender_name, 47 | filename => $filename, 48 | mode => $mode, 49 | autoflush => $autoflush, 50 | ); 51 | } 52 | 53 | 1; 54 | 55 | =encoding utf8 56 | 57 | =head1 NAME 58 | 59 | Log::Log4perl::JavaMap::FileAppender - wraps Log::Dispatch::File 60 | 61 | =head1 SYNOPSIS 62 | 63 | 64 | =head1 DESCRIPTION 65 | 66 | Possible config properties for log4j ConsoleAppender are 67 | 68 | File 69 | Append "true|false|1|0" default=true 70 | BufferedIO "true|false|1|0" default=false (i.e. autoflush is on) 71 | 72 | Possible config properties for Log::Dispatch::File are 73 | 74 | filename 75 | mode "write|append" 76 | autoflush 0|1 77 | 78 | =head1 SEE ALSO 79 | 80 | http://jakarta.apache.org/log4j/docs/ 81 | 82 | Log::Log4perl::Javamap 83 | 84 | Log::Dispatch::File 85 | 86 | =head1 LICENSE 87 | 88 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 89 | and Kevin Goess Ecpan@goess.orgE. 90 | 91 | This library is free software; you can redistribute it and/or modify 92 | it under the same terms as Perl itself. 93 | 94 | =head1 AUTHOR 95 | 96 | Please contribute patches to the project on Github: 97 | 98 | http://github.com/mschilli/log4perl 99 | 100 | Send bug reports or requests for enhancements to the authors via our 101 | 102 | MAILING LIST (questions, bug reports, suggestions/patches): 103 | log4perl-devel@lists.sourceforge.net 104 | 105 | Authors (please contact them via the list above, not directly): 106 | Mike Schilli , 107 | Kevin Goess 108 | 109 | Contributors (in alphabetical order): 110 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 111 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 112 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 113 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 114 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 115 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 116 | Lars Thegler, David Viner, Mac Yang. 117 | 118 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/JavaMap/NTEventLogAppender.pm: -------------------------------------------------------------------------------- 1 | package Log::Log4perl::JavaMap::NTEventLogAppender; 2 | 3 | use Carp; 4 | use strict; 5 | 6 | 7 | 8 | sub new { 9 | my ($class, $appender_name, $data) = @_; 10 | my $stderr; 11 | 12 | my ($source, # 13 | ); 14 | 15 | if (defined $data->{Source}{value}) { 16 | $source = $data->{Source}{value} 17 | }elsif (defined $data->{source}{value}){ 18 | $source = $data->{source}{value}; 19 | }else{ 20 | $source = 'user'; 21 | } 22 | 23 | 24 | return Log::Log4perl::Appender->new("Log::Dispatch::Win32EventLog", 25 | name => $appender_name, 26 | source => $source, 27 | min_level => 'debug', 28 | ); 29 | } 30 | 31 | 1; 32 | 33 | =encoding utf8 34 | 35 | =head1 NAME 36 | 37 | Log::Log4perl::JavaMap::NTEventLogAppender - wraps Log::Dispatch::Win32EventLog 38 | 39 | 40 | =head1 DESCRIPTION 41 | 42 | This maps log4j's NTEventLogAppender to Log::Dispatch::Win32EventLog 43 | 44 | Possible config properties for log4j NTEventLogAppender are 45 | 46 | Source 47 | 48 | Possible config properties for Log::Dispatch::Win32EventLog are 49 | 50 | source 51 | 52 | Boy, that was hard. 53 | 54 | =head1 SEE ALSO 55 | 56 | http://jakarta.apache.org/log4j/docs/ 57 | 58 | Log::Log4perl::Javamap 59 | 60 | =head1 LICENSE 61 | 62 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 63 | and Kevin Goess Ecpan@goess.orgE. 64 | 65 | This library is free software; you can redistribute it and/or modify 66 | it under the same terms as Perl itself. 67 | 68 | =head1 AUTHOR 69 | 70 | Please contribute patches to the project on Github: 71 | 72 | http://github.com/mschilli/log4perl 73 | 74 | Send bug reports or requests for enhancements to the authors via our 75 | 76 | MAILING LIST (questions, bug reports, suggestions/patches): 77 | log4perl-devel@lists.sourceforge.net 78 | 79 | Authors (please contact them via the list above, not directly): 80 | Mike Schilli , 81 | Kevin Goess 82 | 83 | Contributors (in alphabetical order): 84 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 85 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 86 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 87 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 88 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 89 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 90 | Lars Thegler, David Viner, Mac Yang. 91 | 92 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/JavaMap/SyslogAppender.pm: -------------------------------------------------------------------------------- 1 | package Log::Log4perl::JavaMap::SyslogAppender; 2 | 3 | use Carp; 4 | use strict; 5 | use Log::Dispatch::Syslog; 6 | 7 | 8 | sub new { 9 | my ($class, $appender_name, $data) = @_; 10 | my $stderr; 11 | 12 | my ($ident, #defaults to $0 13 | $logopt, #Valid options are 'cons', 'pid', 'ndelay', and 'nowait'. 14 | $facility, #Valid options are 'auth', 'authpriv', 15 | # 'cron', 'daemon', 'kern', 'local0' through 'local7', 16 | # 'mail, 'news', 'syslog', 'user', 'uucp'. Defaults to 17 | # 'user' 18 | $socket, #Valid options are 'unix' or 'inet'. Defaults to 'inet' 19 | ); 20 | 21 | if (defined $data->{Facility}{value}) { 22 | $facility = $data->{Facility}{value} 23 | }elsif (defined $data->{facility}{value}){ 24 | $facility = $data->{facility}{value}; 25 | }else{ 26 | $facility = 'user'; 27 | } 28 | 29 | if (defined $data->{Ident}{value}) { 30 | $ident = $data->{Ident}{value} 31 | }elsif (defined $data->{ident}{value}){ 32 | $ident = $data->{ident}{value}; 33 | }else{ 34 | $ident = $0; 35 | } 36 | 37 | return Log::Log4perl::Appender->new("Log::Dispatch::Syslog", 38 | name => $appender_name, 39 | facility => $facility, 40 | ident => $ident, 41 | min_level => 'debug', 42 | ); 43 | } 44 | 45 | 1; 46 | 47 | =encoding utf8 48 | 49 | =head1 NAME 50 | 51 | Log::Log4perl::JavaMap::SysLogAppender - wraps Log::Dispatch::Syslog 52 | 53 | 54 | =head1 DESCRIPTION 55 | 56 | This maps log4j's SyslogAppender to Log::Dispatch::Syslog 57 | 58 | Possible config properties for log4j SyslogAppender are 59 | 60 | SyslogHost (Log::Dispatch::Syslog only accepts 'localhost') 61 | Facility 62 | 63 | Possible config properties for Log::Dispatch::Syslog are 64 | 65 | min_level (debug) 66 | max_level 67 | ident (defaults to $0) 68 | logopt 69 | facility 70 | socket (defaults to 'inet') 71 | 72 | =head1 SEE ALSO 73 | 74 | http://jakarta.apache.org/log4j/docs/ 75 | 76 | Log::Log4perl::Javamap 77 | 78 | =head1 LICENSE 79 | 80 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 81 | and Kevin Goess Ecpan@goess.orgE. 82 | 83 | This library is free software; you can redistribute it and/or modify 84 | it under the same terms as Perl itself. 85 | 86 | =head1 AUTHOR 87 | 88 | Please contribute patches to the project on Github: 89 | 90 | http://github.com/mschilli/log4perl 91 | 92 | Send bug reports or requests for enhancements to the authors via our 93 | 94 | MAILING LIST (questions, bug reports, suggestions/patches): 95 | log4perl-devel@lists.sourceforge.net 96 | 97 | Authors (please contact them via the list above, not directly): 98 | Mike Schilli , 99 | Kevin Goess 100 | 101 | Contributors (in alphabetical order): 102 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 103 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 104 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 105 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 106 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 107 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 108 | Lars Thegler, David Viner, Mac Yang. 109 | 110 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/JavaMap/TestBuffer.pm: -------------------------------------------------------------------------------- 1 | package Log::Log4perl::JavaMap::TestBuffer; 2 | 3 | use Carp; 4 | use strict; 5 | use Log::Log4perl::Appender::TestBuffer; 6 | 7 | use constant _INTERNAL_DEBUG => 0; 8 | 9 | sub new { 10 | my ($class, $appender_name, $data) = @_; 11 | my $stderr; 12 | 13 | return Log::Log4perl::Appender->new("Log::Log4perl::Appender::TestBuffer", 14 | name => $appender_name); 15 | } 16 | 17 | 1; 18 | 19 | =encoding utf8 20 | 21 | =head1 NAME 22 | 23 | Log::Log4perl::JavaMap::TestBuffer - wraps Log::Log4perl::Appender::TestBuffer 24 | 25 | =head1 SYNOPSIS 26 | 27 | =head1 DESCRIPTION 28 | 29 | Just for testing the Java mapping. 30 | 31 | =head1 SEE ALSO 32 | 33 | http://jakarta.apache.org/log4j/docs/ 34 | 35 | Log::Log4perl::Javamap 36 | 37 | Log::Dispatch::Screen 38 | 39 | =head1 LICENSE 40 | 41 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 42 | and Kevin Goess Ecpan@goess.orgE. 43 | 44 | This library is free software; you can redistribute it and/or modify 45 | it under the same terms as Perl itself. 46 | 47 | =head1 AUTHOR 48 | 49 | Please contribute patches to the project on Github: 50 | 51 | http://github.com/mschilli/log4perl 52 | 53 | Send bug reports or requests for enhancements to the authors via our 54 | 55 | MAILING LIST (questions, bug reports, suggestions/patches): 56 | log4perl-devel@lists.sourceforge.net 57 | 58 | Authors (please contact them via the list above, not directly): 59 | Mike Schilli , 60 | Kevin Goess 61 | 62 | Contributors (in alphabetical order): 63 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 64 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 65 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 66 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 67 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 68 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 69 | Lars Thegler, David Viner, Mac Yang. 70 | 71 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/Layout.pm: -------------------------------------------------------------------------------- 1 | package Log::Log4perl::Layout; 2 | 3 | 4 | use Log::Log4perl::Layout::SimpleLayout; 5 | use Log::Log4perl::Layout::PatternLayout; 6 | use Log::Log4perl::Layout::PatternLayout::Multiline; 7 | 8 | 9 | #################################################### 10 | sub appender_name { 11 | #################################################### 12 | my ($self, $arg) = @_; 13 | 14 | if ($arg) { 15 | die "setting appender_name unimplemented until it makes sense"; 16 | } 17 | return $self->{appender_name}; 18 | } 19 | 20 | 21 | ################################################## 22 | sub define { 23 | ################################################## 24 | ; #subclasses may implement 25 | } 26 | 27 | 28 | ################################################## 29 | sub render { 30 | ################################################## 31 | die "subclass must implement render"; 32 | } 33 | 34 | 1; 35 | 36 | __END__ 37 | 38 | =encoding utf8 39 | 40 | =head1 NAME 41 | 42 | Log::Log4perl::Layout - Log4perl Layout Virtual Base Class 43 | 44 | =head1 SYNOPSIS 45 | 46 | # Not to be used directly, see below 47 | 48 | =head1 DESCRIPTION 49 | 50 | C is a virtual base class for the two currently 51 | implemented layout types 52 | 53 | Log::Log4perl::Layout::SimpleLayout 54 | Log::Log4perl::Layout::PatternLayout 55 | 56 | Unless you're implementing a new layout class for Log4perl, you shouldn't 57 | use this class directly, but rather refer to 58 | L or 59 | L. 60 | 61 | =head1 LICENSE 62 | 63 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 64 | and Kevin Goess Ecpan@goess.orgE. 65 | 66 | This library is free software; you can redistribute it and/or modify 67 | it under the same terms as Perl itself. 68 | 69 | =head1 AUTHOR 70 | 71 | Please contribute patches to the project on Github: 72 | 73 | http://github.com/mschilli/log4perl 74 | 75 | Send bug reports or requests for enhancements to the authors via our 76 | 77 | MAILING LIST (questions, bug reports, suggestions/patches): 78 | log4perl-devel@lists.sourceforge.net 79 | 80 | Authors (please contact them via the list above, not directly): 81 | Mike Schilli , 82 | Kevin Goess 83 | 84 | Contributors (in alphabetical order): 85 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 86 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 87 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 88 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 89 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 90 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 91 | Lars Thegler, David Viner, Mac Yang. 92 | 93 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/Layout/NoopLayout.pm: -------------------------------------------------------------------------------- 1 | ################################################## 2 | package Log::Log4perl::Layout::NoopLayout; 3 | ################################################## 4 | 5 | 6 | ################################################## 7 | sub new { 8 | ################################################## 9 | my $class = shift; 10 | $class = ref ($class) || $class; 11 | 12 | my $self = { 13 | format => undef, 14 | info_needed => {}, 15 | stack => [], 16 | }; 17 | 18 | bless $self, $class; 19 | 20 | return $self; 21 | } 22 | 23 | ################################################## 24 | sub render { 25 | ################################################## 26 | #my($self, $message, $category, $priority, $caller_level) = @_; 27 | return $_[1];; 28 | } 29 | 30 | 1; 31 | 32 | __END__ 33 | 34 | =encoding utf8 35 | 36 | =head1 NAME 37 | 38 | Log::Log4perl::Layout::NoopLayout - Pass-thru Layout 39 | 40 | =head1 SYNOPSIS 41 | 42 | use Log::Log4perl::Layout::NoopLayout; 43 | my $layout = Log::Log4perl::Layout::NoopLayout->new(); 44 | 45 | =head1 DESCRIPTION 46 | 47 | This is a no-op layout, returns the logging message unaltered, 48 | useful for implementing the DBI logger. 49 | 50 | =head1 LICENSE 51 | 52 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 53 | and Kevin Goess Ecpan@goess.orgE. 54 | 55 | This library is free software; you can redistribute it and/or modify 56 | it under the same terms as Perl itself. 57 | 58 | =head1 AUTHOR 59 | 60 | Please contribute patches to the project on Github: 61 | 62 | http://github.com/mschilli/log4perl 63 | 64 | Send bug reports or requests for enhancements to the authors via our 65 | 66 | MAILING LIST (questions, bug reports, suggestions/patches): 67 | log4perl-devel@lists.sourceforge.net 68 | 69 | Authors (please contact them via the list above, not directly): 70 | Mike Schilli , 71 | Kevin Goess 72 | 73 | Contributors (in alphabetical order): 74 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 75 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 76 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 77 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 78 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 79 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 80 | Lars Thegler, David Viner, Mac Yang. 81 | 82 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/Layout/PatternLayout/Multiline.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | package Log::Log4perl::Layout::PatternLayout::Multiline; 4 | use base qw(Log::Log4perl::Layout::PatternLayout); 5 | 6 | ########################################### 7 | sub render { 8 | ########################################### 9 | my($self, $message, $category, $priority, $caller_level) = @_; 10 | 11 | my @messages = split /\r?\n/, $message; 12 | 13 | $caller_level = 0 unless defined $caller_level; 14 | 15 | my $result = ''; 16 | 17 | for my $msg ( @messages ) { 18 | $result .= $self->SUPER::render( 19 | $msg, $category, $priority, $caller_level + 1 20 | ); 21 | } 22 | return $result; 23 | } 24 | 25 | 1; 26 | 27 | __END__ 28 | 29 | =encoding utf8 30 | 31 | =head1 NAME 32 | 33 | Log::Log4perl::Layout::PatternLayout::Multiline 34 | 35 | =head1 SYNOPSIS 36 | 37 | use Log::Log4perl::Layout::PatternLayout::Multiline; 38 | 39 | my $layout = Log::Log4perl::Layout::PatternLayout::Multiline->new( 40 | "%d (%F:%L)> %m"); 41 | 42 | =head1 DESCRIPTION 43 | 44 | C is a subclass 45 | of Log4perl's PatternLayout and is helpful if you send multiline 46 | messages to your appenders which appear as 47 | 48 | 2007/04/04 23:59:01 This is 49 | a message with 50 | multiple lines 51 | 52 | and you want them to appear as 53 | 54 | 2007/04/04 23:59:01 This is 55 | 2007/04/04 23:59:01 a message with 56 | 2007/04/04 23:59:01 multiple lines 57 | 58 | instead. This layout class simply splits up the incoming message into 59 | several chunks split by line breaks and renders them with PatternLayout 60 | just as if it had arrived in separate chunks in the first place. 61 | 62 | =head1 LICENSE 63 | 64 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 65 | and Kevin Goess Ecpan@goess.orgE. 66 | 67 | This library is free software; you can redistribute it and/or modify 68 | it under the same terms as Perl itself. 69 | 70 | =head1 AUTHOR 71 | 72 | Please contribute patches to the project on Github: 73 | 74 | http://github.com/mschilli/log4perl 75 | 76 | Send bug reports or requests for enhancements to the authors via our 77 | 78 | MAILING LIST (questions, bug reports, suggestions/patches): 79 | log4perl-devel@lists.sourceforge.net 80 | 81 | Authors (please contact them via the list above, not directly): 82 | Mike Schilli , 83 | Kevin Goess 84 | 85 | Contributors (in alphabetical order): 86 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 87 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 88 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 89 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 90 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 91 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 92 | Lars Thegler, David Viner, Mac Yang. 93 | 94 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/Layout/SimpleLayout.pm: -------------------------------------------------------------------------------- 1 | ################################################## 2 | package Log::Log4perl::Layout::SimpleLayout; 3 | ################################################## 4 | # as documented in 5 | # http://jakarta.apache.org/log4j/docs/api/org/apache/log4j/SimpleLayout.html 6 | ################################################## 7 | 8 | use 5.006; 9 | use strict; 10 | use warnings; 11 | use Log::Log4perl::Level; 12 | 13 | no strict qw(refs); 14 | use base qw(Log::Log4perl::Layout); 15 | 16 | ################################################## 17 | sub new { 18 | ################################################## 19 | my $class = shift; 20 | $class = ref ($class) || $class; 21 | 22 | my $self = { 23 | format => undef, 24 | info_needed => {}, 25 | stack => [], 26 | }; 27 | 28 | bless $self, $class; 29 | 30 | return $self; 31 | } 32 | 33 | ################################################## 34 | sub render { 35 | ################################################## 36 | my($self, $message, $category, $priority, $caller_level) = @_; 37 | 38 | return "$priority - $message\n"; 39 | } 40 | 41 | 1; 42 | 43 | __END__ 44 | 45 | =encoding utf8 46 | 47 | =head1 NAME 48 | 49 | Log::Log4perl::Layout::SimpleLayout - Simple Layout 50 | 51 | =head1 SYNOPSIS 52 | 53 | use Log::Log4perl::Layout::SimpleLayout; 54 | my $layout = Log::Log4perl::Layout::SimpleLayout->new(); 55 | 56 | =head1 DESCRIPTION 57 | 58 | This class implements the C simple layout format -- it basically 59 | just prints the message priority and the message, that's all. 60 | Check 61 | http://jakarta.apache.org/log4j/docs/api/org/apache/log4j/SimpleLayout.html 62 | for details. 63 | 64 | =head1 SEE ALSO 65 | 66 | =head1 LICENSE 67 | 68 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 69 | and Kevin Goess Ecpan@goess.orgE. 70 | 71 | This library is free software; you can redistribute it and/or modify 72 | it under the same terms as Perl itself. 73 | 74 | =head1 AUTHOR 75 | 76 | Please contribute patches to the project on Github: 77 | 78 | http://github.com/mschilli/log4perl 79 | 80 | Send bug reports or requests for enhancements to the authors via our 81 | 82 | MAILING LIST (questions, bug reports, suggestions/patches): 83 | log4perl-devel@lists.sourceforge.net 84 | 85 | Authors (please contact them via the list above, not directly): 86 | Mike Schilli , 87 | Kevin Goess 88 | 89 | Contributors (in alphabetical order): 90 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 91 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 92 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 93 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 94 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 95 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 96 | Lars Thegler, David Viner, Mac Yang. 97 | 98 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/MDC.pm: -------------------------------------------------------------------------------- 1 | ################################################## 2 | package Log::Log4perl::MDC; 3 | ################################################## 4 | 5 | use 5.006; 6 | use strict; 7 | use warnings; 8 | 9 | our %MDC_HASH = (); 10 | 11 | ########################################### 12 | sub get { 13 | ########################################### 14 | my($class, $key) = @_; 15 | 16 | if($class ne __PACKAGE__) { 17 | # Somebody called us with Log::Log4perl::MDC::get($key) 18 | $key = $class; 19 | } 20 | 21 | if(exists $MDC_HASH{$key}) { 22 | return $MDC_HASH{$key}; 23 | } else { 24 | return undef; 25 | } 26 | } 27 | 28 | ########################################### 29 | sub put { 30 | ########################################### 31 | my($class, $key, $value) = @_; 32 | 33 | if($class ne __PACKAGE__) { 34 | # Somebody called us with Log::Log4perl::MDC::put($key, $value) 35 | $value = $key; 36 | $key = $class; 37 | } 38 | 39 | $MDC_HASH{$key} = $value; 40 | } 41 | 42 | ########################################### 43 | sub remove { 44 | ########################################### 45 | %MDC_HASH = (); 46 | 47 | 1; 48 | } 49 | 50 | ########################################### 51 | sub get_context { 52 | ########################################### 53 | return \%MDC_HASH; 54 | } 55 | 56 | 1; 57 | 58 | __END__ 59 | 60 | =encoding utf8 61 | 62 | =head1 NAME 63 | 64 | Log::Log4perl::MDC - Mapped Diagnostic Context 65 | 66 | =head1 DESCRIPTION 67 | 68 | Log::Log4perl allows loggers to maintain global thread-specific data, 69 | called the Nested Diagnostic Context (NDC) and 70 | Mapped Diagnostic Context (MDC). 71 | 72 | The MDC is a simple thread-specific hash table, in which the application 73 | can stuff values under certain keys and retrieve them later 74 | via the C<"%X{key}"> placeholder in 75 | Cs. 76 | 77 | =over 4 78 | 79 | =item Log::Log4perl::MDC->put($key, $value); 80 | 81 | Store a value C<$value> under key C<$key> in the map. 82 | 83 | =item my $value = Log::Log4perl::MDC->get($key); 84 | 85 | Retrieve the content of the map under the specified key. 86 | Typically done by C<%X{key}> in 87 | C. 88 | If no value exists to the given key, C is returned. 89 | 90 | =item my $text = Log::Log4perl::MDC->remove(); 91 | 92 | Delete all entries from the map. 93 | 94 | =item Log::Log4perl::MDC->get_context(); 95 | 96 | Returns a reference to the hash table. 97 | 98 | =back 99 | 100 | Please note that all of the methods above are class methods, there's no 101 | instances of this class. Since the thread model in perl 5.8.0 is 102 | "no shared data unless explicitly requested" the data structures 103 | used are just global (and therefore thread-specific). 104 | 105 | =head1 LICENSE 106 | 107 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 108 | and Kevin Goess Ecpan@goess.orgE. 109 | 110 | This library is free software; you can redistribute it and/or modify 111 | it under the same terms as Perl itself. 112 | 113 | =head1 AUTHOR 114 | 115 | Please contribute patches to the project on Github: 116 | 117 | http://github.com/mschilli/log4perl 118 | 119 | Send bug reports or requests for enhancements to the authors via our 120 | 121 | MAILING LIST (questions, bug reports, suggestions/patches): 122 | log4perl-devel@lists.sourceforge.net 123 | 124 | Authors (please contact them via the list above, not directly): 125 | Mike Schilli , 126 | Kevin Goess 127 | 128 | Contributors (in alphabetical order): 129 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 130 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 131 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 132 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 133 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 134 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 135 | Lars Thegler, David Viner, Mac Yang. 136 | 137 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/Util.pm: -------------------------------------------------------------------------------- 1 | package Log::Log4perl::Util; 2 | 3 | require Exporter; 4 | our @EXPORT_OK = qw( params_check ); 5 | our @ISA = qw( Exporter ); 6 | 7 | use File::Spec; 8 | 9 | ########################################### 10 | sub params_check { 11 | ########################################### 12 | my( $hash, $required, $optional ) = @_; 13 | 14 | my $pkg = caller(); 15 | my %hash_copy = %$hash; 16 | 17 | if( defined $required ) { 18 | for my $p ( @$required ) { 19 | if( !exists $hash->{ $p } or 20 | !defined $hash->{ $p } ) { 21 | die "$pkg: Required parameter $p missing."; 22 | } 23 | delete $hash_copy{ $p }; 24 | } 25 | } 26 | 27 | if( defined $optional ) { 28 | for my $p ( @$optional ) { 29 | delete $hash_copy{ $p }; 30 | } 31 | if( scalar keys %hash_copy ) { 32 | die "$pkg: Unknown parameter: ", join( ",", keys %hash_copy ); 33 | } 34 | } 35 | } 36 | 37 | ################################################## 38 | sub module_available { # Check if a module is available 39 | ################################################## 40 | my($full_name) = @_; 41 | # Weird cases like "strict;" (including the semicolon) would 42 | # succeed with the eval below, so check those up front. 43 | # I can't believe Perl doesn't have a proper way to check if a 44 | # module is available or not! 45 | return 0 if $full_name =~ /[^\w:]/; 46 | $full_name =~ s#::#/#g; 47 | $full_name .= '.pm'; 48 | return 1 if $INC{$full_name}; 49 | eval { 50 | local $SIG{__DIE__} = sub {}; 51 | require $full_name; 52 | }; 53 | return !$@; 54 | } 55 | 56 | ################################################## 57 | sub tmpfile_name { # File::Temp without the bells and whistles 58 | ################################################## 59 | 60 | my $name = File::Spec->catfile(File::Spec->tmpdir(), 61 | 'l4p-tmpfile-' . 62 | "$$-" . 63 | int(rand(9999999))); 64 | 65 | # Some crazy versions of File::Spec use backslashes on Win32 66 | $name =~ s#\\#/#g; 67 | return $name; 68 | } 69 | 70 | 1; 71 | 72 | __END__ 73 | 74 | =encoding utf8 75 | 76 | =head1 NAME 77 | 78 | Log::Log4perl::Util - Internal utility functions 79 | 80 | =head1 DESCRIPTION 81 | 82 | Only internal functions here. Don't peek. 83 | 84 | =head1 LICENSE 85 | 86 | Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE 87 | and Kevin Goess Ecpan@goess.orgE. 88 | 89 | This library is free software; you can redistribute it and/or modify 90 | it under the same terms as Perl itself. 91 | 92 | =head1 AUTHOR 93 | 94 | Please contribute patches to the project on Github: 95 | 96 | http://github.com/mschilli/log4perl 97 | 98 | Send bug reports or requests for enhancements to the authors via our 99 | 100 | MAILING LIST (questions, bug reports, suggestions/patches): 101 | log4perl-devel@lists.sourceforge.net 102 | 103 | Authors (please contact them via the list above, not directly): 104 | Mike Schilli , 105 | Kevin Goess 106 | 107 | Contributors (in alphabetical order): 108 | Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 109 | Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 110 | Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 111 | Grundman, Paul Harrington, Alexander Hartmaier David Hull, 112 | Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 113 | Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 114 | Lars Thegler, David Viner, Mac Yang. 115 | 116 | -------------------------------------------------------------------------------- /t/001Level.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for Log::Log4perl::Level 3 | # Mike Schilli, 2002 (m@perlmeister.com) 4 | ########################################### 5 | 6 | use strict; 7 | use Test::More; 8 | 9 | BEGIN { 10 | if($ENV{INTERNAL_DEBUG}) { 11 | require Log::Log4perl::InternalDebug; 12 | Log::Log4perl::InternalDebug->enable(); 13 | } 14 | } 15 | 16 | use Log::Log4perl::Level; 17 | BEGIN { 18 | Log::Log4perl::Level->import("Level"); 19 | Log::Log4perl::Level->import("My::Level"); 20 | } 21 | ok(1); # If we made it this far, we're ok. 22 | 23 | # Import them into the 'main' namespace; 24 | foreach ($TRACE, $DEBUG, $INFO, $WARN, $ERROR, $FATAL) { 25 | ok(Log::Log4perl::Level::to_level($_)); 26 | } 27 | 28 | # Import them into the 'Level' namespace; 29 | foreach ($Level::TRACE, $Level::DEBUG, $Level::INFO, $Level::WARN, $Level::ERROR, $Level::FATAL) { 30 | ok(Log::Log4perl::Level::to_level($_)); 31 | } 32 | 33 | # Import them into the 'My::Level' namespace; 34 | foreach ($My::Level::DEBUG, $My::Level::DEBUG, $My::Level::INFO, $My::Level::WARN, $My::Level::ERROR, $My::Level::FATAL) { 35 | ok(Log::Log4perl::Level::to_level($_)); 36 | } 37 | 38 | # ok, now let's check to make sure the relative order is correct. 39 | 40 | ok(Log::Log4perl::Level::isGreaterOrEqual($TRACE, $DEBUG)); 41 | ok(Log::Log4perl::Level::isGreaterOrEqual($DEBUG, $INFO)); 42 | ok(Log::Log4perl::Level::isGreaterOrEqual($INFO, $WARN)); 43 | ok(Log::Log4perl::Level::isGreaterOrEqual($WARN, $ERROR)); 44 | ok(Log::Log4perl::Level::isGreaterOrEqual($ERROR, $FATAL)); 45 | 46 | ok(Log::Log4perl::Level::isGreaterOrEqual($Level::TRACE, $Level::DEBUG)); 47 | ok(Log::Log4perl::Level::isGreaterOrEqual($Level::DEBUG, $Level::INFO)); 48 | ok(Log::Log4perl::Level::isGreaterOrEqual($Level::INFO, $Level::WARN)); 49 | ok(Log::Log4perl::Level::isGreaterOrEqual($Level::WARN, $Level::ERROR)); 50 | ok(Log::Log4perl::Level::isGreaterOrEqual($Level::ERROR, $Level::FATAL)); 51 | 52 | ok(Log::Log4perl::Level::isGreaterOrEqual($My::Level::TRACE, 53 | $My::Level::DEBUG)); 54 | ok(Log::Log4perl::Level::isGreaterOrEqual($My::Level::DEBUG, $My::Level::INFO)); 55 | ok(Log::Log4perl::Level::isGreaterOrEqual($My::Level::INFO, $My::Level::WARN)); 56 | ok(Log::Log4perl::Level::isGreaterOrEqual($My::Level::WARN, $My::Level::ERROR)); 57 | ok(Log::Log4perl::Level::isGreaterOrEqual($My::Level::ERROR, $My::Level::FATAL)); 58 | 59 | done_testing; 60 | -------------------------------------------------------------------------------- /t/005Config-Perl.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for Log::Log4perl::Config 3 | # Mike Schilli, 2002 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use Test::More; 14 | use Log::Log4perl; 15 | use Log::Log4perl::Appender::TestBuffer; 16 | use File::Spec; 17 | 18 | my $EG_DIR = "eg"; 19 | $EG_DIR = "../eg" unless -d $EG_DIR; 20 | 21 | ok(1); # If we made it this far, we're ok. 22 | 23 | my $LOGFILE = "example-perl.log"; 24 | unlink $LOGFILE; 25 | 26 | Log::Log4perl->init(File::Spec->catfile($EG_DIR, 'log4j-file-append-perl.conf')); 27 | 28 | my $logger = Log::Log4perl->get_logger(""); 29 | my $line = __LINE__ + 1; 30 | $logger->debug("Gurgel"); 31 | 32 | open LOG, "<$LOGFILE" or die "Cannot open $LOGFILE"; 33 | my $data = ; 34 | 35 | END { close LOG; unlink $LOGFILE; } 36 | 37 | is($data, "005Config-Perl.t $line DEBUG N/A - Gurgel\n"); 38 | 39 | ############################################### 40 | # Check reading a config file via a file handle 41 | ############################################### 42 | Log::Log4perl->reset(); 43 | open FILE, File::Spec->catfile($EG_DIR, 'log4j-file-append-perl.conf') or 44 | die "cannot open log4j-file-append-perl.conf"; 45 | Log::Log4perl->init(\*FILE); 46 | 47 | $logger = Log::Log4perl->get_logger(""); 48 | $line = __LINE__ + 1; 49 | $logger->debug("Gurgel"); 50 | 51 | $data = ; 52 | 53 | is($data, "005Config-Perl.t $line DEBUG N/A - Gurgel\n"); 54 | 55 | done_testing; 56 | -------------------------------------------------------------------------------- /t/006Config-Java.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for Log::Log4perl::Config 3 | # Mike Schilli, 2002 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use Test::More; 14 | 15 | our $LOG_DISPATCH_PRESENT = 0; 16 | 17 | BEGIN { 18 | eval { require Log::Dispatch; }; 19 | if($@) { 20 | plan skip_all => "only with Log::Dispatch"; 21 | } else { 22 | $LOG_DISPATCH_PRESENT = 1; 23 | plan tests => 2; 24 | } 25 | }; 26 | 27 | use Log::Log4perl; 28 | use Log::Log4perl::Appender::TestBuffer; 29 | use File::Spec; 30 | 31 | my $EG_DIR = "eg"; 32 | $EG_DIR = "../eg" unless -d $EG_DIR; 33 | 34 | ok(1); # If we made it this far, we're ok. 35 | 36 | my $LOGFILE = "example-java.log"; 37 | unlink $LOGFILE; 38 | 39 | #Log::Log4perl->init( 40 | # File::Spec->catfile($EG_DIR, 'log4j-file-append-java.conf')); 41 | Log::Log4perl->init("$EG_DIR/log4j-file-append-java.conf"); 42 | 43 | 44 | my $logger = Log::Log4perl->get_logger(""); 45 | my $lines = (); 46 | my $line = __LINE__ + 1; 47 | push @lines, $line++; $logger->debug("Gurgel"); 48 | push @lines, $line++; $logger->info("Gurgel"); 49 | push @lines, $line++; $logger->warn("Gurgel"); 50 | push @lines, $line++; $logger->error("Gurgel"); 51 | push @lines, $line++; $logger->fatal("Gurgel"); 52 | 53 | open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE"; 54 | my $data = join '', ; 55 | close FILE; 56 | 57 | my $file = "t/006Config-Java.t"; 58 | 59 | my $exp = <enable(); 10 | } 11 | } 12 | 13 | use Test::More; 14 | use Log::Log4perl; 15 | use Log::Log4perl::Appender::TestBuffer; 16 | use File::Spec; 17 | 18 | my $EG_DIR = "eg"; 19 | $EG_DIR = "../eg" unless -d $EG_DIR; 20 | 21 | ok(1); # If we made it this far, we're ok. 22 | 23 | my $LOGFILE = "example-perl2.log"; 24 | unlink $LOGFILE; 25 | 26 | Log::Log4perl->init( \ <get_logger(""); 38 | my @lines = (); 39 | my $line = __LINE__ + 1; 40 | push @lines, $line++; $logger->debug("Gurgel"); 41 | push @lines, $line++; $logger->info("Gurgel"); 42 | push @lines, $line++; $logger->warn("Gurgel"); 43 | push @lines, $line++; $logger->error("Gurgel"); 44 | push @lines, $line++; $logger->fatal("Gurgel"); 45 | 46 | open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE"; 47 | my $data = join '', ; 48 | close FILE; 49 | 50 | my $file = "007LogPrio.t"; 51 | 52 | my $exp = <enable(); 10 | } 11 | } 12 | 13 | use Test::More; 14 | use Log::Log4perl; 15 | use Log::Log4perl::Appender::TestBuffer; 16 | 17 | my $EG_DIR = "eg"; 18 | $EG_DIR = "../eg" unless -d $EG_DIR; 19 | 20 | my $date_regex = qr(\d{4}/\d\d/\d\d \d\d:\d\d:\d\d); 21 | 22 | ok(1); # If we made it this far, we're ok. 23 | 24 | ###################################################################### 25 | # Test a 'foo.bar.baz' logger which inherits level from foo.bar 26 | # and calls both "foo.bar" and "root" appenders with their respective 27 | # formats 28 | # on a configuration file defining a file appender 29 | ###################################################################### 30 | Log::Log4perl->init("$EG_DIR/log4j-manual-2.conf"); 31 | 32 | my $logger = Log::Log4perl->get_logger("foo.bar.baz"); 33 | $logger->debug("Gurgel"); 34 | 35 | like(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 36 | qr#$date_regex \[N/A\] DEBUG foo.bar.baz - Gurgel#); 37 | 38 | ###################################################################### 39 | # Test the root logger via inheritance (discovered by Kevin Goess) 40 | ###################################################################### 41 | Log::Log4perl->reset(); 42 | 43 | Log::Log4perl::Appender::TestBuffer->reset(); 44 | 45 | Log::Log4perl->init("$EG_DIR/log4j-manual-2.conf"); 46 | 47 | $logger = Log::Log4perl->get_logger("foo"); 48 | $logger->debug("Gurgel"); 49 | 50 | like(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 51 | qr#$date_regex \[N/A\] DEBUG foo - Gurgel#); 52 | 53 | done_testing; 54 | -------------------------------------------------------------------------------- /t/009Deuce.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for Log::Log4perl 3 | # Test two appenders in one category 4 | # Mike Schilli, 2002 (m@perlmeister.com) 5 | ########################################### 6 | 7 | BEGIN { 8 | if($ENV{INTERNAL_DEBUG}) { 9 | require Log::Log4perl::InternalDebug; 10 | Log::Log4perl::InternalDebug->enable(); 11 | } 12 | } 13 | 14 | use Test::More; 15 | use Log::Log4perl; 16 | use Log::Log4perl::Appender::TestBuffer; 17 | 18 | my $EG_DIR = "eg"; 19 | $EG_DIR = "../eg" unless -d $EG_DIR; 20 | 21 | ok(1); # If we made it this far, we're ok. 22 | 23 | ###################################################################### 24 | # Test the root logger on a configuration file defining a file appender 25 | ###################################################################### 26 | Log::Log4perl->init("$EG_DIR/log4j-manual-3.conf"); 27 | 28 | my $logger = Log::Log4perl->get_logger(""); 29 | $logger->debug("Gurgel"); 30 | 31 | ok(Log::Log4perl::Appender::TestBuffer->by_name("stdout")->buffer(), 32 | 'm#^\S+\s+\[N/A\] \(\S+?:\d+\) - Gurgel$#'); 33 | ok(Log::Log4perl::Appender::TestBuffer->by_name("R")->buffer(), 34 | 'm#^\S+\s+N/A\s+\'\' - Gurgel$#'); 35 | 36 | ###################################################################### 37 | # Test the root logger via inheritance (discovered by Kevin Goess) 38 | ###################################################################### 39 | Log::Log4perl->reset(); 40 | Log::Log4perl::Appender::TestBuffer->reset(); 41 | 42 | Log::Log4perl->init("$EG_DIR/log4j-manual-3.conf"); 43 | 44 | $logger = Log::Log4perl->get_logger("foo"); 45 | $logger->debug("Gurgel"); 46 | 47 | ok(Log::Log4perl::Appender::TestBuffer->by_name("stdout")->buffer(), 48 | 'm#^\S+\s+\[N/A\] \(\S+?:\d+\) - Gurgel$#'); 49 | ok(Log::Log4perl::Appender::TestBuffer->by_name("R")->buffer(), 50 | 'm#^\S+\s+N/A \'foo\' - Gurgel$#'); 51 | 52 | done_testing; 53 | -------------------------------------------------------------------------------- /t/010JConsole.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if($ENV{INTERNAL_DEBUG}) { 3 | require Log::Log4perl::InternalDebug; 4 | Log::Log4perl::InternalDebug->enable(); 5 | } 6 | } 7 | 8 | use Log::Log4perl; 9 | use Log::Log4perl::Appender::TestBuffer; 10 | use Log::Log4perl::Appender::File; 11 | use File::Spec; 12 | use Test::More; 13 | use lib File::Spec->catdir(qw(t lib)); 14 | use Log4perlInternalTest qw(tmpdir); 15 | 16 | our $LOG_DISPATCH_PRESENT = 0; 17 | 18 | BEGIN { 19 | eval { require Log::Dispatch; }; 20 | if($@) { 21 | plan skip_all => "only with Log::Dispatch"; 22 | } else { 23 | $LOG_DISPATCH_PRESENT = 1; 24 | plan tests => 1; 25 | } 26 | }; 27 | 28 | my $WORK_DIR = tmpdir(); 29 | my $test_logfile = File::Spec->catfile($WORK_DIR,'test1.log'); 30 | 31 | my $conf = <init(\$conf); 41 | 42 | my $logger = Log::Log4perl->get_logger('cat1'); 43 | 44 | #hmm, I wonder how portable this is, maybe check $^O first? 45 | open(OLDOUT, ">&STDOUT"); 46 | open (TOUCH, ">>$test_logfile");# `touch $test_logfile`; 47 | close TOUCH; 48 | open(STDOUT, ">$test_logfile") || die "Can't redirect stdout $test_logfile $!"; 49 | select(STDOUT); $| = 1; # make unbuffered 50 | 51 | $logger->debug("debugging message 1 "); 52 | $logger->info("info message 1 "); 53 | $logger->warn("warning message 1 "); 54 | $logger->fatal("fatal message 1 "); 55 | 56 | close(STDOUT); 57 | open(STDOUT, ">&OLDOUT"); 58 | 59 | my ($result, $expected); 60 | 61 | $expected = <; 70 | close F; 71 | } 72 | my $rc = is ($result, $expected); 73 | 74 | if( !$rc ) { 75 | warn "Failed with Log::Dispatch $Log::Dispatch::VERSION"; 76 | } 77 | 78 | done_testing; 79 | -------------------------------------------------------------------------------- /t/011JFile.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if($ENV{INTERNAL_DEBUG}) { 3 | require Log::Log4perl::InternalDebug; 4 | Log::Log4perl::InternalDebug->enable(); 5 | } 6 | } 7 | 8 | use Log::Log4perl; 9 | use Test::More; 10 | use File::Spec; 11 | use lib File::Spec->catdir(qw(t lib)); 12 | use Log4perlInternalTest qw(tmpdir); 13 | 14 | our $LOG_DISPATCH_PRESENT = 0; 15 | 16 | BEGIN { 17 | eval { require Log::Dispatch; }; 18 | if($@) { 19 | plan skip_all => "only with Log::Dispatch"; 20 | } else { 21 | $LOG_DISPATCH_PRESENT = 1; 22 | plan tests => 1; 23 | } 24 | }; 25 | 26 | my $WORK_DIR = tmpdir(); 27 | my $test_logfile = File::Spec->catfile($WORK_DIR, 'test2.log'); 28 | 29 | my $conf = <init(\$conf); 39 | 40 | my $logger = Log::Log4perl->get_logger('cat1'); 41 | 42 | $logger->debug("debugging message 1 "); 43 | $logger->info("info message 1 "); 44 | $logger->warn("warning message 1 "); 45 | $logger->fatal("fatal message 1 "); 46 | 47 | 48 | my ($result, $expected); 49 | 50 | $expected = <; 59 | close F; 60 | } 61 | is ($result, $expected); 62 | 63 | reset_logger(); 64 | done_testing; 65 | 66 | sub reset_logger { 67 | local $Log::Log4perl::Config::CONFIG_INTEGRITY_CHECK = 0; # to close handles and allow temp files to go 68 | Log::Log4perl::init(\''); 69 | } 70 | -------------------------------------------------------------------------------- /t/018Init.t: -------------------------------------------------------------------------------- 1 | #Testing double-init 2 | 3 | BEGIN { 4 | if($ENV{INTERNAL_DEBUG}) { 5 | require Log::Log4perl::InternalDebug; 6 | Log::Log4perl::InternalDebug->enable(); 7 | } 8 | } 9 | 10 | use strict; 11 | use warnings; 12 | use Test::More; 13 | use Log::Log4perl; 14 | use File::Spec; 15 | use lib File::Spec->catdir(qw(t lib)); 16 | use Log4perlInternalTest qw(tmpdir); 17 | 18 | my $WORK_DIR = tmpdir(); 19 | my $testfilea = File::Spec->catfile($WORK_DIR, qw(test18a.log)); 20 | my $testfileb = File::Spec->catfile($WORK_DIR, qw(test18b.log)); 21 | 22 | #################################################### 23 | # Double-Init, 2nd time with different log file name 24 | #################################################### 25 | my $data = <info("Shu-wa-chi!"); 36 | 37 | $data = <info("Shu-wa-chi!"); 48 | 49 | # Check if both files contain one message each 50 | for my $file ($testfilea, $testfileb) { 51 | open FILE, "<$file" or die "Cannot open $file"; 52 | my $content = join '', ; 53 | close FILE; 54 | ok($content, "INFO - Shu-wa-chi!\n"); 55 | } 56 | 57 | reset_logger(); 58 | done_testing; 59 | 60 | sub reset_logger { 61 | local $Log::Log4perl::Config::CONFIG_INTEGRITY_CHECK = 0; # to close handles and allow temp files to go 62 | Log::Log4perl::init(\''); 63 | } 64 | -------------------------------------------------------------------------------- /t/019Warn.t: -------------------------------------------------------------------------------- 1 | # Check if warnings are issued for weirdo configurations 2 | 3 | BEGIN { 4 | if($ENV{INTERNAL_DEBUG}) { 5 | require Log::Log4perl::InternalDebug; 6 | Log::Log4perl::InternalDebug->enable(); 7 | } 8 | } 9 | 10 | use strict; 11 | use warnings; 12 | use Test::More; 13 | use Log::Log4perl; 14 | use File::Spec; 15 | use lib File::Spec->catdir(qw(t lib)); 16 | use Log4perlInternalTest qw(tmpdir); 17 | 18 | my $WORK_DIR = tmpdir(); 19 | my $TMP_FILE = File::Spec->catfile($WORK_DIR, qw(warnings)); 20 | 21 | ok(1); # Initialized ok 22 | 23 | # Capture STDERR to a temporary file and a filehandle to read from it 24 | open STDERR, ">$TMP_FILE"; 25 | open IN, "<$TMP_FILE" or die "Cannot open $TMP_FILE"; 26 | sub readwarn { return scalar ; } 27 | 28 | ############################################################ 29 | # Get a logger and use it without having called init() first 30 | ############################################################ 31 | my $log = Log::Log4perl::get_logger("abc.def"); 32 | $log->debug("hey there"); 33 | 34 | my $warn = readwarn(); 35 | #print "'$warn'\n"; 36 | 37 | like($warn, qr#Forgot#); 38 | done_testing; 39 | 40 | __END__ 41 | 42 | ############################################################ 43 | # Check for single \'s on line ends -- they need to be 44 | # \\ for perl to recognize it. But how? Perl swallows it. 45 | ############################################################ 46 | my $conf = <init(\$conf); 59 | 60 | my $err = readwarn(); 61 | 62 | ok($err, 'm#single \\#i'); 63 | 64 | print "$conf\n"; 65 | -------------------------------------------------------------------------------- /t/020Easy2.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # 020Easy2.t - more Easy tests 3 | # Mike Schilli, 2004 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use strict; 14 | use warnings; 15 | use Log::Log4perl::Appender::TestBuffer; 16 | 17 | my $stderr = ""; 18 | 19 | $SIG{__WARN__} = sub { 20 | #print "warn: <$_[0]>\n"; 21 | $stderr .= $_[0]; 22 | }; 23 | 24 | use Test::More; 25 | use Log::Log4perl qw(:easy); 26 | 27 | Log::Log4perl->init(\ q{ 28 | log4perl.category.Bar.Twix = WARN, Term 29 | log4perl.appender.Term = Log::Log4perl::Appender::Screen 30 | log4perl.appender.Term.layout = Log::Log4perl::Layout::SimpleLayout 31 | }); 32 | 33 | # This case caused a warning L4p 0.47 34 | INFO "Boo!"; 35 | 36 | is($stderr, "", "no warning"); 37 | 38 | # Test new level TRACE 39 | 40 | Log::Log4perl->init(\ q{ 41 | log4perl.category = TRACE, Buf 42 | log4perl.appender.Buf = Log::Log4perl::Appender::TestBuffer 43 | log4perl.appender.Buf.layout = Log::Log4perl::Layout::SimpleLayout 44 | }); 45 | 46 | my $appenders = Log::Log4perl->appenders(); 47 | my $bufapp = Log::Log4perl::Appender::TestBuffer->by_name("Buf"); 48 | 49 | TRACE("foobar"); 50 | is($bufapp->buffer(), "TRACE - foobar\n", "TRACE check"); 51 | 52 | Log::Log4perl->init(\ q{ 53 | log4perl.category = DEBUG, Buf 54 | log4perl.appender.Buf = Log::Log4perl::Appender::TestBuffer 55 | log4perl.appender.Buf.layout = Log::Log4perl::Layout::SimpleLayout 56 | }); 57 | $bufapp = Log::Log4perl::Appender::TestBuffer->by_name("Buf"); 58 | 59 | my $log = Log::Log4perl::get_logger(""); 60 | $log->trace("We don't want to see this"); 61 | is($bufapp->buffer(), "", "Suppressed trace() check"); 62 | 63 | done_testing; 64 | -------------------------------------------------------------------------------- /t/022Wrap.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Tests for Log4perl used by a wrapper class 3 | # Mike Schilli, 2002 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use strict; 14 | use warnings; 15 | use Test::More; 16 | use File::Basename; 17 | 18 | ################################################## 19 | package Wrapper::Log4perl; 20 | 21 | use Log::Log4perl; 22 | use Log::Log4perl::Level; 23 | 24 | our @ISA = qw(Log::Log4perl); 25 | 26 | sub get_logger { 27 | # This is highly stupid (object duplication) and definitely not what we 28 | # want anybody to do, but just to have a test case for a logger in a 29 | # wrapper package 30 | return Wrapper::Log4perl::Logger->new(@_); 31 | } 32 | 33 | ################################################## 34 | package Wrapper::Log4perl::Logger; 35 | Log::Log4perl->wrapper_register(__PACKAGE__); 36 | sub new { 37 | my $real_logger = Log::Log4perl::get_logger(@_); 38 | bless { real_logger => $real_logger }, $_[0]; 39 | } 40 | sub AUTOLOAD { 41 | no strict; 42 | my $self = shift; 43 | $AUTOLOAD =~ s/.*:://; 44 | $self->{real_logger}->$AUTOLOAD(@_); 45 | } 46 | sub DESTROY {} 47 | 48 | ################################################## 49 | package main; 50 | 51 | use Log::Log4perl; 52 | local $Log::Log4perl::caller_depth = 53 | $Log::Log4perl::caller_depth + 1; 54 | use Log::Log4perl::Level; 55 | 56 | my $log0 = Wrapper::Log4perl->get_logger(""); 57 | $log0->level($DEBUG); 58 | 59 | my $app0 = Log::Log4perl::Appender->new( 60 | "Log::Log4perl::Appender::TestBuffer"); 61 | my $layout = Log::Log4perl::Layout::PatternLayout->new( 62 | "File: %F{1} Line number: %L package: %C trace: %T"); 63 | $app0->layout($layout); 64 | $log0->add_appender($app0); 65 | 66 | ################################################## 67 | my $rootlogger = Wrapper::Log4perl->get_logger(""); 68 | my $line = __LINE__ + 1; 69 | $rootlogger->debug("Hello"); 70 | 71 | my $buf = $app0->buffer(); 72 | $buf =~ s#(\S+022Wrap\.t)#basename( $1 )#eg; 73 | 74 | # [rt 74836] Carp.pm added a dot at the end with 1.25. 75 | # Be dot-agnostic. 76 | $buf =~ s/\.$//; 77 | 78 | is($buf, 79 | "File: 022Wrap.t Line number: $line package: main " . 80 | "trace: at 022Wrap.t line $line", 81 | "appender check"); 82 | 83 | # with the new wrapper_register in Log4perl 1.29, this will even work 84 | # *without* modifying caller_depth 85 | $Log::Log4perl::caller_depth--; 86 | $app0->buffer(""); 87 | $line = __LINE__ + 1; 88 | $rootlogger->debug("Hello"); 89 | 90 | # Win32 91 | # [rt 74836] Carp.pm added a dot at the end with 1.25. 92 | # Be dot-agnostic. 93 | $buf = $app0->buffer(); 94 | $buf =~ s/\.$//; 95 | $buf =~ s#(\S+022Wrap\.t)#basename( $1 )#eg; 96 | 97 | is($buf, 98 | "File: 022Wrap.t Line number: $line package: main " . 99 | "trace: at 022Wrap.t line $line", 100 | "appender check"); 101 | 102 | ################################################## 103 | package L4p::Wrapper; 104 | Log::Log4perl->wrapper_register(__PACKAGE__); 105 | no strict qw(refs); 106 | *get_logger = sub { 107 | 108 | my @args = @_; 109 | 110 | if(defined $args[0] and $args[0] eq __PACKAGE__) { 111 | $args[0] =~ s/__PACKAGE__/Log::Log4perl/g; 112 | } 113 | Log::Log4perl::get_logger( @args ); 114 | }; 115 | 116 | package main; 117 | 118 | my $logger = L4p::Wrapper::get_logger(); 119 | is $logger->{category}, "main", "cat on () is main"; 120 | 121 | $logger = L4p::Wrapper::get_logger(__PACKAGE__); 122 | is $logger->{category}, "main", "cat on (__PACKAGE__) is main"; 123 | 124 | $logger = L4p::Wrapper->get_logger(); 125 | is $logger->{category}, "main", "cat on ->() is main"; 126 | 127 | # use Data::Dumper; 128 | # print Dumper($logger); 129 | 130 | done_testing; 131 | -------------------------------------------------------------------------------- /t/027Watch3.t: -------------------------------------------------------------------------------- 1 | #testing init_and_watch 2 | #same as 027Watch2, just with signal handling instead of watch/delay code 3 | 4 | BEGIN { 5 | if($ENV{INTERNAL_DEBUG}) { 6 | require Log::Log4perl::InternalDebug; 7 | Log::Log4perl::InternalDebug->enable(); 8 | } 9 | } 10 | 11 | use strict; 12 | use warnings; 13 | use Test::More; 14 | use File::Spec; 15 | use lib File::Spec->catdir(qw(t lib)); 16 | use Log4perlInternalTest qw(tmpdir need_signals); 17 | 18 | BEGIN { 19 | need_signals(); 20 | } 21 | 22 | use Log::Log4perl; 23 | use Log::Log4perl::Appender::TestBuffer; 24 | use File::Spec; 25 | 26 | my $WORK_DIR = tmpdir(); 27 | my $testconf= File::Spec->catfile($WORK_DIR, "test27.conf"); 28 | 29 | Log::Log4perl::Appender::TestBuffer->reset(); 30 | 31 | my $conf1 = <$testconf") || die "can't open $testconf $!"; 46 | print CONF $conf1; 47 | close CONF; 48 | 49 | Log::Log4perl->init_and_watch($testconf, 'HUP'); 50 | 51 | my $logger = Log::Log4perl::get_logger('animal.dog'); 52 | 53 | ok( $logger->is_debug(), "is_debug - true"); 54 | ok( $logger->is_info(), "is_info - true"); 55 | ok( $logger->is_warn(), "is_warn - true"); 56 | ok( $logger->is_error(), "is_error - true"); 57 | ok( $logger->is_fatal(), "is_fatal - true"); 58 | 59 | my $app0 = Log::Log4perl::Appender::TestBuffer->by_name("myAppender"); 60 | 61 | $logger->debug('debug message, should appear'); 62 | 63 | is($app0->buffer(), "DEBUG - debug message, should appear\n", "debug()"); 64 | 65 | 66 | #--------------------------- 67 | #now reload and then signal 68 | 69 | $conf1 = <$testconf") || die "can't open $testconf $!"; 84 | print CONF $conf1; 85 | close CONF; 86 | 87 | #--------------------------- 88 | # send the signal to the process itself 89 | kill(1, $$) or die "Cannot signal"; 90 | 91 | ok(! $logger->is_debug(), "is_debug - false"); 92 | ok(! $logger->is_info(), "is_info - false"); 93 | ok( $logger->is_warn(), "is_warn - true"); 94 | ok( $logger->is_error(), "is_error - true"); 95 | ok( $logger->is_fatal(), "is_fatal - true"); 96 | 97 | #now the logger is ruled by root's WARN level 98 | $logger->debug('debug message, should NOT appear'); 99 | 100 | my $app1 = Log::Log4perl::Appender::TestBuffer->by_name("myAppender"); 101 | 102 | is($app1->buffer(), "", "buffer empty"); 103 | 104 | $logger->warn('warning message, should appear'); 105 | 106 | is($app1->buffer(), "WARN - warning message, should appear\n", "warn in"); 107 | 108 | #check the root logger 109 | $logger = Log::Log4perl::get_logger(); 110 | 111 | $logger->warn('warning message, should appear'); 112 | 113 | like($app1->buffer(), qr/(WARN - warning message, should appear\n){2}/, 114 | "2nd warn in"); 115 | 116 | # ------------------------------------------- 117 | #double-check an unrelated category with a lower level 118 | $logger = Log::Log4perl::get_logger('animal.cat'); 119 | $logger->info('warning message to cat, should appear'); 120 | 121 | like($app1->buffer(), qr/(WARN - warning message, should appear\n){2}INFO - warning message to cat, should appear/, "message output"); 122 | 123 | done_testing; 124 | -------------------------------------------------------------------------------- /t/027Watch4.t: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl -w 2 | 3 | BEGIN { 4 | if($ENV{INTERNAL_DEBUG}) { 5 | require Log::Log4perl::InternalDebug; 6 | Log::Log4perl::InternalDebug->enable(); 7 | } 8 | } 9 | 10 | use strict; 11 | use warnings; 12 | use Test::More; 13 | use Log::Log4perl::Config::Watch; 14 | use File::Spec; 15 | use lib File::Spec->catdir(qw(t lib)); 16 | use Log4perlInternalTest qw(need_signals); 17 | 18 | BEGIN { 19 | need_signals(); 20 | } 21 | 22 | my $EG_DIR = "eg"; 23 | $EG_DIR = "../eg" unless -d $EG_DIR; 24 | 25 | # sample file to run tests on 26 | my $file = "$EG_DIR/log4j-manual-1.conf"; 27 | 28 | my $w = Log::Log4perl::Config::Watch->new( 29 | file => $file, 30 | signal => 'USR1', 31 | ); 32 | 33 | $w->change_detected(); 34 | $Log::Log4perl::Config::Watch::L4P_TEST_CHANGE_DETECTED = 0; 35 | $Log::Log4perl::Config::Watch::L4P_TEST_CHANGE_CHECKED = 0; 36 | $w->change_detected(); 37 | 38 | is($Log::Log4perl::Config::Watch::L4P_TEST_CHANGE_CHECKED, 39 | 0, "no change checked without signal"); 40 | is($Log::Log4perl::Config::Watch::L4P_TEST_CHANGE_DETECTED, 41 | 0, "no change detected without signal"); 42 | 43 | $w->force_next_check(); 44 | $w->change_detected(); 45 | 46 | is($Log::Log4perl::Config::Watch::L4P_TEST_CHANGE_CHECKED, 47 | 1, "change checked after force_next_check()"); 48 | is($Log::Log4perl::Config::Watch::L4P_TEST_CHANGE_DETECTED, 49 | 0, "no change detected after force_next_check()"); 50 | 51 | done_testing; 52 | -------------------------------------------------------------------------------- /t/029SysWide.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for Log::Log4perl::Logger 3 | # Mike Schilli, 2002 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use strict; 14 | use warnings; 15 | use Test::More; 16 | use Log::Log4perl qw(get_logger); 17 | use Log::Log4perl::Level; 18 | use Log::Log4perl::Appender::TestBuffer; 19 | 20 | ok(1); # If we made it this far, we're ok. 21 | 22 | ################################################## 23 | # System-wide threshold 24 | ################################################## 25 | # Reset appender population 26 | Log::Log4perl::Appender::TestBuffer->reset(); 27 | 28 | my $conf = <by_name("BUF0"); 38 | 39 | my $loga = get_logger("a"); 40 | 41 | $loga->info("Don't want to see this"); 42 | $loga->error("Yeah, loga"); 43 | 44 | is($app0->buffer(), "ERROR - Yeah, loga\n"); 45 | 46 | ################################################## 47 | # System-wide threshold with appender threshold 48 | ################################################## 49 | # Reset appender population 50 | Log::Log4perl::Appender::TestBuffer->reset(); 51 | 52 | $conf = <by_name("BUF0"); 67 | my $app1 = Log::Log4perl::Appender::TestBuffer->by_name("BUF1"); 68 | 69 | $loga = get_logger("a"); 70 | 71 | $loga->info("Don't want to see this"); 72 | $loga->error("Yeah, loga"); 73 | 74 | is($app0->buffer(), "ERROR - Yeah, loga\n"); 75 | is($app1->buffer(), "ERROR - Yeah, loga\n"); 76 | 77 | ############################################################ 78 | # System-wide threshold shouldn't lower appender thresholds 79 | ############################################################ 80 | # Reset appender population 81 | Log::Log4perl::Appender::TestBuffer->reset(); 82 | 83 | $conf = q( 84 | log4perl.threshold = DEBUG 85 | log4perl.category = INFO, BUF0 86 | log4perl.appender.BUF0.Threshold = WARN 87 | log4perl.appender.BUF0 = Log::Log4perl::Appender::TestBuffer 88 | log4perl.appender.BUF0.layout = Log::Log4perl::Layout::SimpleLayout 89 | ); 90 | 91 | Log::Log4perl::init(\$conf); 92 | 93 | my $logger = get_logger(); 94 | $logger->info("Blah"); 95 | 96 | $app0 = Log::Log4perl::Appender::TestBuffer->by_name("BUF0"); 97 | is($app0->buffer(), "", "syswide threshold shouldn't lower app thresholds"); 98 | 99 | ############################################################ 100 | # System-wide threshold shouldn't lower appender thresholds 101 | ############################################################ 102 | # Reset appender population 103 | Log::Log4perl::Appender::TestBuffer->reset(); 104 | 105 | $conf = q( 106 | log4perl.threshold = ERROR 107 | log4perl.category = INFO, BUF0 108 | log4perl.appender.BUF0.Threshold = DEBUG 109 | log4perl.appender.BUF0 = Log::Log4perl::Appender::TestBuffer 110 | log4perl.appender.BUF0.layout = Log::Log4perl::Layout::SimpleLayout 111 | ); 112 | 113 | Log::Log4perl::init(\$conf); 114 | 115 | $logger = get_logger(); 116 | $logger->warn("Blah"); 117 | 118 | $app0 = Log::Log4perl::Appender::TestBuffer->by_name("BUF0"); 119 | is($app0->buffer(), "", "syswide threshold trumps thresholds"); 120 | 121 | done_testing; 122 | -------------------------------------------------------------------------------- /t/030LDLevel.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for Log::Log4perl::Logger 3 | # Mike Schilli, 2002 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use strict; 14 | use warnings; 15 | use Test::More; 16 | use Log::Log4perl qw(get_logger); 17 | use Log::Log4perl::Level; 18 | use Log::Log4perl::Appender::TestBuffer; 19 | 20 | ok(1); # If we made it this far, we're ok. 21 | 22 | # Have TestBuffer log the Log::Dispatch priority 23 | $Log::Log4perl::Appender::TestBuffer::LOG_PRIORITY = 1; 24 | Log::Log4perl::Appender::TestBuffer->reset(); 25 | 26 | my $conf = <by_name("BUF0"); 35 | 36 | my $loga = get_logger("a"); 37 | 38 | $loga->debug("debug"); 39 | $loga->info("info"); 40 | $loga->warn("warn"); 41 | $loga->error("error"); 42 | $loga->fatal("fatal"); 43 | 44 | is($app0->buffer(), 45 | "[0]: DEBUG - debug\n" . 46 | "[1]: INFO - info\n" . 47 | "[3]: WARN - warn\n" . 48 | "[4]: ERROR - error\n" . 49 | "[7]: FATAL - fatal\n" . 50 | "" 51 | ); 52 | 53 | done_testing; 54 | -------------------------------------------------------------------------------- /t/031NDC.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite Log::Log4perl::NDC 3 | # Mike Schilli, 2002 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use strict; 14 | use warnings; 15 | use Test::More; 16 | use Log::Log4perl qw(get_logger); 17 | use Log::Log4perl::Level; 18 | use Log::Log4perl::Appender::TestBuffer; 19 | use Log::Log4perl::NDC; 20 | use Log::Log4perl::MDC; 21 | 22 | # Have TestBuffer log the Log::Dispatch priority 23 | Log::Log4perl::Appender::TestBuffer->reset(); 24 | 25 | my $conf = < 30 | EOT 31 | 32 | Log::Log4perl::init(\$conf); 33 | 34 | my $app0 = Log::Log4perl::Appender::TestBuffer->by_name("BUF0"); 35 | 36 | my $loga = get_logger("a"); 37 | 38 | Log::Log4perl::NDC->push("first"); 39 | $loga->debug("debug"); 40 | 41 | # Push more than MAX 42 | Log::Log4perl::NDC->push("second"); 43 | Log::Log4perl::NDC->push("third"); 44 | Log::Log4perl::NDC->push("fourth"); 45 | Log::Log4perl::NDC->push("fifth"); 46 | Log::Log4perl::NDC->push("sixth"); 47 | $loga->info("info"); 48 | 49 | # Delete NDC stack 50 | Log::Log4perl::NDC->remove(); 51 | $loga->warn("warn"); 52 | 53 | Log::Log4perl::NDC->push("seventh"); 54 | $loga->error("error"); 55 | 56 | is($app0->buffer(), 57 | "debug info warn <[undef]>error "); 58 | 59 | Log::Log4perl::Appender::TestBuffer->reset(); 60 | 61 | Log::Log4perl::MDC->put("remote_host", "blah-host"); 62 | Log::Log4perl::MDC->put("ip", "blah-ip"); 63 | 64 | $conf = <by_name("BUF1"); 74 | 75 | my $logb = get_logger("b"); 76 | 77 | $logb->debug("testmessage"); 78 | 79 | is($app1->buffer(), 80 | "blah-host: testmessage blah-ip\n"); 81 | 82 | # Check what happens if %X is used with an undef value 83 | Log::Log4perl::Appender::TestBuffer->reset(); 84 | 85 | $conf = <by_name("BUF1"); 95 | 96 | $logb = get_logger("b"); 97 | 98 | $logb->debug("testmessage"); 99 | 100 | is($app1->buffer(), 101 | "[undef]: testmessage blah-ip\n"); 102 | 103 | done_testing; 104 | -------------------------------------------------------------------------------- /t/032JRollFile.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if($ENV{INTERNAL_DEBUG}) { 3 | require Log::Log4perl::InternalDebug; 4 | Log::Log4perl::InternalDebug->enable(); 5 | } 6 | } 7 | 8 | use Log::Log4perl; 9 | use Test::More; 10 | use File::Spec; 11 | use lib File::Spec->catdir(qw(t lib)); 12 | use Log4perlInternalTest qw(tmpdir); 13 | 14 | eval { 15 | require Log::Dispatch::FileRotate; 16 | Log::Dispatch::FileRotate->VERSION(1.10); 1 17 | } or plan skip_all => "only with Log::Dispatch::FileRotate 1.10"; 18 | 19 | my $WORK_DIR = tmpdir(); 20 | 21 | my $conf = <catfile($WORK_DIR, 'rolltest.log')]} 26 | #this will roll the file after one write 27 | log4j.appender.myAppender.MaxFileSize=1024 28 | log4j.appender.myAppender.MaxBackupIndex=2 29 | log4j.appender.myAppender.layout=org.apache.log4j.PatternLayout 30 | log4j.appender.myAppender.layout.ConversionPattern=%-5p %c - %m%n 31 | 32 | CONF 33 | 34 | Log::Log4perl->init(\$conf); 35 | 36 | my $logger = Log::Log4perl->get_logger('cat1'); 37 | 38 | $logger->debug("x" x 1024 . "debugging message 1 "); 39 | $logger->info("x" x 1024 . "info message 1 "); 40 | $logger->warn("x" x 1024 . "warning message 1 "); 41 | $logger->fatal("x" x 1024 . "fatal message 1 "); 42 | 43 | my $rollfile = File::Spec->catfile($WORK_DIR, 'rolltest.log.2'); 44 | 45 | open F, $rollfile or die "Cannot open $rollfile"; 46 | my $result = ; 47 | close F; 48 | like($result, qr/^INFO cat1 - x+info message 1/); 49 | 50 | #MaxBackupIndex is 2, so this file shouldn't exist 51 | ok(! -e File::Spec->catfile($WORK_DIR, 'rolltest.log.3')); 52 | 53 | reset_logger(); 54 | done_testing; 55 | 56 | sub reset_logger { 57 | local $Log::Log4perl::Config::CONFIG_INTEGRITY_CHECK = 0; # to close handles and allow temp files to go 58 | Log::Log4perl::init(\''); 59 | } 60 | -------------------------------------------------------------------------------- /t/035JDBCAppender.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test using Log::Dispatch::DBI 3 | # Kevin Goess 4 | ########################################### 5 | 6 | use strict; 7 | use warnings; 8 | 9 | our $table_name = "log4perl$$"; 10 | 11 | BEGIN { 12 | if($ENV{INTERNAL_DEBUG}) { 13 | require Log::Log4perl::InternalDebug; 14 | Log::Log4perl::InternalDebug->enable(); 15 | } 16 | } 17 | 18 | use Test::More; 19 | 20 | use Log::Log4perl; 21 | use lib File::Spec->catdir(qw(t lib)); 22 | use Log4perlInternalTest qw(tmpdir min_version); 23 | 24 | BEGIN { 25 | min_version(qw( DBI DBD::CSV Log::Dispatch )); 26 | plan tests => 14; 27 | } 28 | 29 | my $WORK_DIR = tmpdir(); 30 | require DBI; 31 | my $dbh = DBI->connect('DBI:CSV:f_dir='.$WORK_DIR,'testuser','testpw',{ PrintError => 1 }); 32 | 33 | my $stmt = <do($stmt); 48 | 49 | #creating a log statement where bind values 1,3,5 and 6 are 50 | #calculated from conversion specifiers and 2,4,7,8 are 51 | #calculated at runtime and fed to the $logger->whatever(...) 52 | #statement 53 | 54 | my $config = <<"EOT"; 55 | #log4j.category = WARN, DBAppndr, console 56 | log4j.category = WARN, DBAppndr 57 | log4j.appender.DBAppndr = org.apache.log4j.jdbc.JDBCAppender 58 | log4j.appender.DBAppndr.URL = jdbc:CSV:testdb://localhost:9999;f_dir=$WORK_DIR 59 | log4j.appender.DBAppndr.user = bobjones 60 | log4j.appender.DBAppndr.password = 12345 61 | log4j.appender.DBAppndr.sql = \\ 62 | insert into $table_name \\ 63 | (loglevel, message, shortcaller, thingid, category, pkg, runtime1, runtime2) \\ 64 | values (?,?,?,?,?,?,?,?) 65 | log4j.appender.DBAppndr.params.1 = %p 66 | #---------------------------- #2 is message 67 | log4j.appender.DBAppndr.params.3 = %5.5l 68 | #---------------------------- #4 is thingid 69 | log4j.appender.DBAppndr.params.5 = %c 70 | log4j.appender.DBAppndr.params.6 = %C 71 | #-----------------------------#7,8 are also runtime 72 | 73 | log4j.appender.DBAppndr.bufferSize=3 74 | log4j.appender.DBAppndr.warp_message=0 75 | 76 | #noop layout to pass it through 77 | log4j.appender.DBAppndr.layout = Log::Log4perl::Layout::NoopLayout 78 | 79 | #a console appender for debugging 80 | log4j.appender.console = Log::Log4perl::Appender::Screen 81 | log4j.appender.console.layout = Log::Log4perl::Layout::SimpleLayout 82 | 83 | EOT 84 | 85 | Log::Log4perl::init(\$config); 86 | 87 | 88 | # ********************* 89 | # check a category logger 90 | 91 | my $logger = Log::Log4perl->get_logger("groceries.beer"); 92 | 93 | #$logger->fatal('fatal message',1234,'foo','bar'); 94 | $logger->fatal('fatal message',1234,'foo', 'bar'); 95 | $logger->warn('warning message',3456,'foo','bar'); 96 | $logger->debug('debug message',99,'foo','bar'); 97 | 98 | my $sth = $dbh->prepare("select * from $table_name"); 99 | $sth->execute; 100 | 101 | my $row = $sth->fetchrow_arrayref; 102 | is($row->[0], 'FATAL'); 103 | is($row->[1], 'fatal message'); 104 | is($row->[3], '1234'); 105 | is($row->[4], 'groceries.beer'); 106 | is($row->[5], 'main'); 107 | is($row->[6], 'foo'); 108 | is($row->[7], 'bar'); 109 | 110 | $row = $sth->fetchrow_arrayref; 111 | is($row->[0], 'WARN'); 112 | is($row->[1], 'warning message'); 113 | is($row->[3], '3456'); 114 | is($row->[4], 'groceries.beer'); 115 | is($row->[5], 'main'); 116 | is($row->[6], 'foo'); 117 | is($row->[7], 'bar'); 118 | 119 | $dbh->do("DROP TABLE $table_name"); 120 | 121 | done_testing; 122 | -------------------------------------------------------------------------------- /t/036JSyslog.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if($ENV{INTERNAL_DEBUG}) { 3 | require Log::Log4perl::InternalDebug; 4 | Log::Log4perl::InternalDebug->enable(); 5 | } 6 | } 7 | 8 | use Log::Log4perl; 9 | use Test::More; 10 | 11 | #skipping on win32 systems 12 | eval { require Sys::Syslog; 1 } or plan skip_all => "Sys::Syslog not installed"; 13 | 14 | print <init(\$conf); 47 | 48 | my $logger = Log::Log4perl->get_logger('cat1'); 49 | 50 | 51 | $logger->debug("debugging message 1 "); 52 | $logger->info("info message 1 "); 53 | $logger->warn("warning message 1 "); 54 | 55 | }; 56 | 57 | ok 1; 58 | done_testing; 59 | -------------------------------------------------------------------------------- /t/037JWin32Event.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if($ENV{INTERNAL_DEBUG}) { 3 | require Log::Log4perl::InternalDebug; 4 | Log::Log4perl::InternalDebug->enable(); 5 | } 6 | } 7 | 8 | use Log::Log4perl; 9 | use Test::More; 10 | 11 | #skipping on non-win32 systems 12 | eval { require Log::Dispatch::Win32EventLog; 1 } or 13 | plan skip_all => "only with Log::Dispatch::Win32EventLog"; 14 | 15 | print <init(\$conf); 40 | 41 | my $logger = Log::Log4perl->get_logger('cat1'); 42 | 43 | 44 | $logger->debug("debugging message 1 "); 45 | $logger->info("info message 1 "); 46 | $logger->warn("warning message 1 "); 47 | 48 | #if we didn't die, we got here 49 | ok(1); 50 | 51 | done_testing; 52 | -------------------------------------------------------------------------------- /t/046RRDs.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for RRDs appenders 3 | # Mike Schilli, 2004 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use strict; 14 | use warnings; 15 | use Test::More; 16 | use Log::Log4perl qw(get_logger); 17 | 18 | my $DB = "myrrddb.dat"; 19 | 20 | BEGIN { eval 'require RRDs'; 21 | if($@) { 22 | plan skip_all => "(RRDs not installed)"; 23 | } 24 | }; 25 | END { unlink $DB }; 26 | 27 | use RRDs; 28 | 29 | RRDs::create( 30 | $DB, "--step=1", 31 | "DS:myvalue:GAUGE:2:U:U", 32 | "RRA:MAX:0.5:1:120"); 33 | 34 | Log::Log4perl->init(\qq{ 35 | log4perl.category = INFO, RRDapp 36 | log4perl.appender.RRDapp = Log::Log4perl::Appender::RRDs 37 | log4perl.appender.RRDapp.dbname = $DB 38 | log4perl.appender.RRDapp.layout = Log::Log4perl::Layout::PatternLayout 39 | log4perl.appender.RRDapp.layout.ConversionPattern = N:%m 40 | }); 41 | 42 | my $logger = get_logger(); 43 | 44 | for(10, 15, 20) { 45 | $logger->info($_); 46 | sleep 1; 47 | } 48 | 49 | my ($start,$step,$names,$data) = 50 | RRDs::fetch($DB, "MAX", 51 | "--start" => time() - 20); 52 | $data = join ' - ', map { "@$_" } grep { defined $_->[0] } @$data; 53 | #print $data; 54 | 55 | like($data, qr/\d\d/); 56 | done_testing; 57 | -------------------------------------------------------------------------------- /t/047-ldap.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for LDAP appenders 3 | # Kevin Goess, 2004 (cpan@goess.org) 4 | # 5 | # To run this test, you need to ... DEBUG 6 | # 7 | 8 | 9 | #NOTE: the LDAP stuff is all experimental and in-progress, 10 | #not meant to be used for ANYTHING yet --kg 5/2004 11 | 12 | =pod 13 | 14 | L4P_DO_LDAP_TESTS=1 \ 15 | LOG4PERL_LDAP_USERDN='cn=log4perluser,dc=people,dc=goess,dc=org' \ 16 | LOG4PERL_LDAP_PWD=54321 \ 17 | LDAP_HOST=localhost \ 18 | LDAP_BASE=dc=testsystem,dc=log4perl,dc=goess,dc=org \ 19 | perl -Ilib -Iblib/lib t/047-ldap.t 20 | 21 | 22 | L4P_DO_LDAP_TESTS=1 \ 23 | LOG4PERL_LDAP_USERDN='uid=kgoess,ou=People,dc=mrs.hudson,dc=goess,dc=org' \ 24 | LOG4PERL_LDAP_PWD=ldap123 \ 25 | LDAP_HOST=localhost \ 26 | LDAP_BASE=dc=l4ptest,dc=system,dc=mrs.hudson,dc=goess,dc=org \ 27 | perl -Ilib -Iblib/lib t/047-ldap.t 28 | 29 | 30 | =cut 31 | 32 | # 33 | ########################################### 34 | 35 | #Note: should handle ldaps as well DEBUG 36 | 37 | BEGIN { 38 | if($ENV{INTERNAL_DEBUG}) { 39 | require Log::Log4perl::InternalDebug; 40 | Log::Log4perl::InternalDebug->enable(); 41 | } 42 | } 43 | 44 | use warnings; 45 | use strict; 46 | 47 | use Test::More; 48 | 49 | use Log::Log4perl qw(get_logger); 50 | 51 | plan skip_all => 'L4P_DO_LDAP_TESTS not set' if !$ENV{L4P_DO_LDAP_TESTS}; 52 | require Net::LDAP; 53 | require URI::ldap; 54 | 55 | Log::Log4perl->init(\qq{ 56 | log4perl.category = INFO, LDAPapp 57 | log4perl.appender.LDAPapp = Log::Log4perl::Appender::TestBuffer 58 | log4perl.appender.LDAPapp.layout = Log::Log4perl::Layout::PatternLayout 59 | log4perl.appender.LDAPapp.layout.ConversionPattern = N:%m 60 | }); 61 | 62 | my $uri = URI->new("ldap:"); # start empty 63 | 64 | $uri->host($ENV{LDAP_HOST}); #see above for run values 65 | $uri->dn($ENV{LDAP_BASE}); #see above 66 | #$uri->attributes(qw(postalAddress)); 67 | $uri->scope('sub'); 68 | #$uri->filter('(cn=Babs Jensen)'); 69 | # ldap://localhost/dc=testsystem,dc=log4perl,dc=goess,dc=org??sub? 70 | 71 | 72 | #ldap://localhost/dc=testsystem,dc=log4perl,dc=goess,dc=org??sub? 73 | 74 | my $ldapdata = Log::Log4perl::Config::config_read( 75 | $uri->as_string 76 | ); 77 | 78 | my $WORK_DIR = tmpdir(); 79 | my $propsconfig = <enable(); 10 | } 11 | } 12 | 13 | use strict; 14 | use warnings; 15 | 16 | use Test::More; 17 | 18 | BEGIN { 19 | eval { 20 | require LWP::UserAgent; 21 | die "Skip tests" if $LWP::UserAgent::VERSION < 2.0; 22 | die "Skip tests" if $LWP::UserAgent::VERSION >= 5.822; 23 | }; 24 | 25 | if($@) { 26 | plan skip_all => "Only with 2.0 < LWP::UserAgent < 5.822 "; 27 | } 28 | } 29 | 30 | use Log::Log4perl qw(:easy); 31 | use Log::Log4perl::Util; 32 | 33 | Log::Log4perl->easy_init( 34 | { level => $DEBUG, 35 | category => "LWP::UserAgent", 36 | file => 'lwpout.txt' 37 | }); 38 | 39 | Log::Log4perl->infiltrate_lwp(); 40 | 41 | my $ua = LWP::UserAgent->new(); 42 | 43 | my $tmpfile = Log::Log4perl::Util::tmpfile_name(); 44 | END { unlink $tmpfile }; 45 | $ua->get("file:$tmpfile"); 46 | 47 | open LOG, "); 49 | close LOG; 50 | 51 | like($data, qr#\QGET file:$tmpfile\E#); 52 | 53 | END { unlink "lwpout.txt" } 54 | 55 | #################################### 56 | # Check different category 57 | #################################### 58 | Log::Log4perl->reset(); 59 | Log::Log4perl->easy_init( 60 | { level => $DEBUG, 61 | category => "LWP::SchmoozeAgent", 62 | file => '>lwpout.txt' 63 | }); 64 | 65 | Log::Log4perl->infiltrate_lwp(); 66 | 67 | $ua = LWP::UserAgent->new(); 68 | $ua->get("file:$tmpfile"); 69 | 70 | open LOG, "); 72 | close LOG; 73 | 74 | is($data, ''); 75 | 76 | #################################### 77 | # Check layout 78 | #################################### 79 | Log::Log4perl->reset(); 80 | Log::Log4perl->easy_init( 81 | { level => $DEBUG, 82 | category => "LWP::UserAgent", 83 | file => '>lwpout.txt', 84 | layout => '%F-%L: %m%n', 85 | }); 86 | 87 | Log::Log4perl->infiltrate_lwp(); 88 | 89 | $ua = LWP::UserAgent->new(); 90 | $ua->get("file:$tmpfile"); 91 | 92 | open LOG, "); 94 | close LOG; 95 | 96 | like($data, qr#LWP/UserAgent.pm-\d+#); 97 | 98 | done_testing; 99 | -------------------------------------------------------------------------------- /t/049Unhide.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for ':resurrect' tag 3 | # Mike Schilli, 2004 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use warnings; 14 | use strict; 15 | 16 | use Test::More; 17 | use Log::Log4perl::Appender::TestBuffer; 18 | 19 | use Log::Log4perl qw(:easy :resurrect); 20 | 21 | eval { 22 | require Filter::Util::Call; 23 | }; 24 | if($@) { 25 | plan skip_all => "Filter::Util::Call not available"; 26 | } 27 | 28 | Log::Log4perl->easy_init($DEBUG); 29 | 30 | Log::Log4perl::Appender::TestBuffer->reset(); 31 | 32 | Log::Log4perl->init(\ <by_name("A1")->buffer(), 45 | "first \nsecond \nthird \n", "Hidden statements via ###l4p"); 46 | 47 | done_testing; 48 | -------------------------------------------------------------------------------- /t/050Buffer.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for 'Buffer' appender 3 | # Mike Schilli, 2004 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use strict; 14 | use warnings; 15 | 16 | use Test::More; 17 | use Log::Log4perl::Appender::TestBuffer; 18 | use Log::Log4perl qw(:easy); 19 | 20 | my $conf = q( 21 | log4perl.category = DEBUG, Buffer 22 | log4perl.category.triggertest = DEBUG, Buffer2 23 | 24 | # Regular Screen Appender 25 | log4perl.appender.Screen = Log::Log4perl::Appender::TestBuffer 26 | log4perl.appender.Screen.layout = PatternLayout 27 | log4perl.appender.Screen.layout.ConversionPattern = %d %p %c %m %n 28 | 29 | # Buffering appender, using the appender above as outlet 30 | log4perl.appender.Buffer = Log::Log4perl::Appender::Buffer 31 | log4perl.appender.Buffer.appender = Screen 32 | log4perl.appender.Buffer.trigger_level = ERROR 33 | 34 | # Second Screen Appender 35 | log4perl.appender.Screen2 = Log::Log4perl::Appender::TestBuffer 36 | log4perl.appender.Screen2.layout = PatternLayout 37 | log4perl.appender.Screen2.layout.ConversionPattern = %d %p %c %m %n 38 | 39 | # Buffering appender, with a subroutine reference as a trigger 40 | log4perl.appender.Buffer2 = Log::Log4perl::Appender::Buffer 41 | log4perl.appender.Buffer2.appender = Screen2 42 | log4perl.appender.Buffer2.trigger = sub { \ 43 | my($self, $params) = @_; \ 44 | return Log::Log4perl::Level::to_priority($params->{log4p_level}) >= \ 45 | Log::Log4perl::Level::to_priority('ERROR') } 46 | 47 | ); 48 | 49 | Log::Log4perl->init(\$conf); 50 | 51 | my $buf = Log::Log4perl::Appender::TestBuffer->by_name("Screen"); 52 | 53 | DEBUG("This message gets buffered."); 54 | is($buf->buffer(), "", "Buffering DEBUG"); 55 | 56 | INFO("This message gets buffered also."); 57 | is($buf->buffer(), "", "Buffering INFO"); 58 | 59 | ERROR("This message triggers a buffer flush."); 60 | like($buf->buffer(), qr/DEBUG.*?INFO.*?ERROR/s, "Flushing ERROR"); 61 | 62 | 63 | # testing trigger sub 64 | 65 | my $buf2 = Log::Log4perl::Appender::TestBuffer->by_name("Screen2"); 66 | 67 | my $logger = Log::Log4perl->get_logger('triggertest'); 68 | $logger->debug("This message gets buffered."); 69 | is($buf2->buffer(), "", "Buffering DEBUG"); 70 | 71 | $logger->info("This message gets buffered also."); 72 | is($buf2->buffer(), "", "Buffering INFO"); 73 | 74 | $logger->error("This message triggers a buffer flush."); 75 | like($buf2->buffer(), qr/DEBUG.*?INFO.*?ERROR/s, "Flushing ERROR"); 76 | 77 | done_testing; 78 | -------------------------------------------------------------------------------- /t/051Extra.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for :no_extra_logdie_message 3 | # Mike Schilli, 2005 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use strict; 14 | use warnings; 15 | use Log::Log4perl qw(:easy :no_extra_logdie_message); 16 | use Test::More; 17 | use File::Spec; 18 | use lib File::Spec->catdir(qw(t lib)); 19 | use Log4perlInternalTest qw(tmpdir); 20 | 21 | BEGIN { 22 | if ($] < 5.008) { 23 | plan skip_all => "Only with perl >= 5.008"; 24 | } 25 | } 26 | 27 | use Log::Log4perl::Appender::TestBuffer; 28 | 29 | is($Log::Log4perl::LOGDIE_MESSAGE_ON_STDERR, 0, "internal variable set"); 30 | 31 | my $conf = qq( 32 | log4perl.category = DEBUG, Screen 33 | 34 | # Regular Screen Appender 35 | log4perl.appender.Screen = Log::Log4perl::Appender::TestBuffer 36 | log4perl.appender.Screen.layout = PatternLayout 37 | log4perl.appender.Screen.layout.ConversionPattern = %d %p %c %m %n 38 | ); 39 | 40 | Log::Log4perl->init(\$conf); 41 | 42 | ######################################################################### 43 | # Capture STDERR to a temporary file and a filehandle to read from it 44 | 45 | my $WORK_DIR = tmpdir(); 46 | my $TMP_FILE = File::Spec->catfile($WORK_DIR, qw(easy)); 47 | 48 | open STDERR, ">$TMP_FILE"; 49 | select STDERR; $| = 1; #needed on win32 50 | open IN, "<$TMP_FILE" or die "Cannot open $TMP_FILE"; binmode IN, ":utf8"; 51 | sub readstderr { IN->clearerr(); return join("", ); } 52 | 53 | END { unlink $TMP_FILE; 54 | close IN; 55 | } 56 | ######################################################################### 57 | 58 | my $buf = Log::Log4perl::Appender::TestBuffer->by_name("Screen"); 59 | 60 | $buf->buffer(""); 61 | my $line_ref = __LINE__ + 1; 62 | LOGCARP("logcarp"); 63 | 64 | like(readstderr(), qr/logcarp at /, "Output to stderr"); 65 | SKIP: { use Carp; 66 | skip "Detected buggy Carp.pm (upgrade to perl-5.8.*)", 3 unless 67 | defined $Carp::VERSION; 68 | like($buf->buffer(), qr/logcarp.*$line_ref/, "Appender output intact"); 69 | $buf->buffer(""); 70 | $line_ref = __LINE__ + 1; 71 | LOGCARP("logcarp"); 72 | like(readstderr(), qr/logcarp at /, "Output to stderr"); 73 | like($buf->buffer(), qr/logcarp.*$line_ref/, "Appender output intact"); 74 | } 75 | 76 | $line_ref += 6; 77 | $buf->clear; 78 | LOGWARN("Doesn't call 'exit'"); 79 | is(readstderr(), "", "No output to stderr"); 80 | like($buf->buffer(), qr/Doesn't call 'exit'/, "Appender output intact"); 81 | ######################################################################### 82 | # Turn default behaviour back on 83 | ######################################################################### 84 | $Log::Log4perl::LOGDIE_MESSAGE_ON_STDERR ^= 1; 85 | $buf->buffer(""); 86 | 87 | package Foo; 88 | use Log::Log4perl qw(:easy); 89 | sub foo { 90 | LOGCARP("logcarp"); 91 | } 92 | package main; 93 | 94 | Foo::foo(); 95 | 96 | $line_ref += 17; 97 | like(readstderr(), qr/logcarp.*$line_ref/, "Output to stderr"); 98 | like($buf->buffer(), qr/logcarp.*$line_ref/, "Appender output intact"); 99 | 100 | $buf->buffer(""); 101 | eval { 102 | LOGDIE("logdie"); 103 | }; 104 | $line_ref += 8; 105 | like($@, qr/logdie.*$line_ref/, "Output to stderr"); 106 | like($buf->buffer(), qr/logdie/, "Appender output intact"); 107 | 108 | done_testing; 109 | -------------------------------------------------------------------------------- /t/053Resurrect.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for Log::Log4perl::Resurrector 3 | # Mike Schilli, 2007 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use strict; 14 | use Test::More; 15 | use Log::Log4perl qw(:easy); 16 | 17 | BEGIN { 18 | my $eg = "eg"; 19 | $eg = "../eg" unless -d $eg; 20 | push @INC, $eg; 21 | }; 22 | 23 | use Log::Log4perl::Resurrector; 24 | use L4pResurrectable; 25 | 26 | Log::Log4perl->init(\ <<'EOT'); 27 | log4perl.logger = DEBUG, A1 28 | log4perl.appender.A1 = Log::Log4perl::Appender::TestBuffer 29 | log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout 30 | EOT 31 | 32 | my $buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1"); 33 | 34 | L4pResurrectable::foo(); 35 | is($buffer->buffer(), "DEBUG - foo was here\nINFO - bar was here\n", 36 | "resurrected statement"); 37 | 38 | done_testing; 39 | -------------------------------------------------------------------------------- /t/054Subclass.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for Log::Log4perl::Level 3 | # Mike Schilli, 2008 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | ########################################### 14 | # Subclass L4p 15 | package Mylogger; 16 | use strict; 17 | use Log::Log4perl; 18 | our @ISA = qw(Log::Log4perl); 19 | 20 | ########################################### 21 | package main; 22 | use strict; 23 | 24 | use Test::More; 25 | 26 | my $logger = Mylogger->get_logger("Waah"); 27 | is($logger->{category}, "Waah", "subclass category rt #32942"); 28 | 29 | done_testing; 30 | -------------------------------------------------------------------------------- /t/055AppDestroy.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | ################################################################### 3 | # Check if a custom appender with a destroy handler gets its 4 | # warning through 5 | ################################################################### 6 | 7 | BEGIN { 8 | if($ENV{INTERNAL_DEBUG}) { 9 | require Log::Log4perl::InternalDebug; 10 | Log::Log4perl::InternalDebug->enable(); 11 | } 12 | } 13 | 14 | package SomeAppender; 15 | our @ISA = qw(Log::Log4perl::Appender); 16 | sub new { 17 | bless {}, shift; 18 | } 19 | sub log {} 20 | sub DESTROY { 21 | warn "Horrible Warning!"; 22 | } 23 | 24 | package main; 25 | use warnings; 26 | use strict; 27 | use Test::More; 28 | use Log::Log4perl qw(:easy); 29 | 30 | my $warnings; 31 | 32 | $SIG{__WARN__} = sub { 33 | $warnings .= $_[0]; 34 | }; 35 | 36 | my $conf = q( 37 | log4perl.category = DEBUG, SomeA 38 | log4perl.appender.SomeA = SomeAppender 39 | log4perl.appender.SomeA.layout = Log::Log4perl::Layout::SimpleLayout 40 | ); 41 | 42 | Log::Log4perl->init(\$conf); 43 | 44 | my $logger = get_logger(); 45 | $logger->debug("foo"); 46 | 47 | Log::Log4perl::Logger->cleanup(); 48 | 49 | END { 50 | ok 1; # under Devel::Cover, $warnings can end up undef 51 | like $warnings, qr/Horrible Warning!/, "app destruction warning caught" if defined $warnings; 52 | done_testing; 53 | } 54 | -------------------------------------------------------------------------------- /t/056SyncApp2.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | ########################################################################## 3 | # The test checks Log::Log4perl::Appender::Synchronized for correct semaphore 4 | # destruction when using parameter "destroy". 5 | # Based on: 042SyncApp.t 6 | # Jens Berthold, 2009 (log4perl@jebecs.de) 7 | ########################################################################## 8 | use warnings; 9 | use strict; 10 | 11 | BEGIN { 12 | if($ENV{INTERNAL_DEBUG}) { 13 | require Log::Log4perl::InternalDebug; 14 | Log::Log4perl::InternalDebug->enable(); 15 | } 16 | } 17 | 18 | use Test::More; 19 | use Log::Log4perl qw(:easy); 20 | Log::Log4perl->easy_init($DEBUG); 21 | use constant INTERNAL_DEBUG => 0; 22 | 23 | our $INTERNAL_DEBUG = 0; 24 | 25 | $| = 1; 26 | 27 | BEGIN { 28 | if(!exists $ENV{"L4P_ALL_TESTS"}) { 29 | plan skip_all => "- only with L4P_ALL_TESTS"; 30 | } 31 | } 32 | 33 | use Log::Log4perl::Util::Semaphore; 34 | use Log::Log4perl qw(get_logger); 35 | use Log::Log4perl::Appender::Synchronized; 36 | 37 | my $EG_DIR = "eg"; 38 | $EG_DIR = "../eg" unless -d $EG_DIR; 39 | 40 | my $logfile = "$EG_DIR/fork.log"; 41 | 42 | our $lock; 43 | 44 | unlink $logfile; 45 | 46 | my $conf = qq( 47 | log4perl.category.Bar.Twix = WARN, Syncer 48 | 49 | log4perl.appender.Logfile = Log::Log4perl::Appender::TestFileCreeper 50 | log4perl.appender.Logfile.autoflush = 1 51 | log4perl.appender.Logfile.filename = $logfile 52 | log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout 53 | log4perl.appender.Logfile.layout.ConversionPattern = %F{1}%L> %m%n 54 | 55 | log4perl.appender.Syncer = Log::Log4perl::Appender::Synchronized 56 | log4perl.appender.Syncer.appender = Logfile 57 | log4perl.appender.Syncer.key = blah 58 | log4perl.appender.Syncer.destroy = 1 59 | ); 60 | 61 | Log::Log4perl::init(\$conf); 62 | 63 | my $pid = fork(); 64 | 65 | die "fork failed" unless defined $pid; 66 | 67 | my $logger = get_logger("Bar::Twix"); 68 | if($pid) { 69 | # parent 70 | # no logging test here: if child erroneously deletes semaphore, 71 | # any log output at this point would crash the test 72 | } else { 73 | # child 74 | exit 0; 75 | } 76 | 77 | # Wait for child to finish 78 | print "Waiting for pid $pid\n" if $INTERNAL_DEBUG; 79 | waitpid($pid, 0); 80 | print "Done waiting for pid $pid\n" if $INTERNAL_DEBUG; 81 | unlink $logfile; 82 | 83 | # Destroying appender (+semaphore) fails if child process already destroyed it 84 | Log::Log4perl->appender_by_name('Syncer')->DESTROY(); 85 | ok(!$@, "Destroying appender"); 86 | 87 | done_testing; 88 | -------------------------------------------------------------------------------- /t/057MsgChomp.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test Suite for Log::Log4perl 3 | # Mike Schilli, 2002 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use strict; 14 | use warnings; 15 | use Test::More; 16 | use Log::Log4perl qw(:easy); 17 | 18 | ######################################################### 19 | # double newline 20 | ######################################################### 21 | my $conf = q( 22 | log4perl.category = DEBUG, Buffer 23 | log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer 24 | log4perl.appender.Buffer.layout = Log::Log4perl::Layout::PatternLayout 25 | log4perl.appender.Buffer.layout.ConversionPattern = %d %F{1} %L> %m%n 26 | ); 27 | 28 | Log::Log4perl->init( \$conf ); 29 | my $buf = Log::Log4perl::Appender::TestBuffer->by_name("Buffer"); 30 | 31 | DEBUG "blah\n"; 32 | DEBUG "blah\n"; 33 | 34 | unlike($buf->buffer(), qr/blah\n\n/); 35 | 36 | ######################################################### 37 | # turn default %m%n chomping feature off 38 | ######################################################### 39 | $conf = q( 40 | log4perl.category = DEBUG, Buffer 41 | log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer 42 | log4perl.appender.Buffer.layout = Log::Log4perl::Layout::PatternLayout 43 | log4perl.appender.Buffer.layout.ConversionPattern = %d %F{1} %L> %m%n 44 | log4perl.appender.Buffer.layout.message_chomp_before_newline = 0 45 | ); 46 | 47 | Log::Log4perl->init( \$conf ); 48 | $buf = Log::Log4perl::Appender::TestBuffer->by_name("Buffer"); 49 | 50 | DEBUG "blah\n"; 51 | DEBUG "blah\n"; 52 | like($buf->buffer(), qr/blah\n\n/); 53 | 54 | ######################################################### 55 | # %m without chomp 56 | ######################################################### 57 | $conf = q( 58 | log4perl.category = DEBUG, Buffer 59 | log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer 60 | log4perl.appender.Buffer.layout = Log::Log4perl::Layout::PatternLayout 61 | log4perl.appender.Buffer.layout.ConversionPattern = %m foo %n 62 | ); 63 | 64 | Log::Log4perl->init( \$conf ); 65 | $buf = Log::Log4perl::Appender::TestBuffer->by_name("Buffer"); 66 | 67 | DEBUG "blah\n"; 68 | like($buf->buffer(), qr/blah\n foo/); 69 | 70 | ######################################################### 71 | # try %m{chomp} 72 | ######################################################### 73 | $conf = q( 74 | log4perl.category = DEBUG, Buffer 75 | log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer 76 | log4perl.appender.Buffer.layout = Log::Log4perl::Layout::PatternLayout 77 | log4perl.appender.Buffer.layout.ConversionPattern = %m{chomp} foo %n 78 | ); 79 | 80 | Log::Log4perl->init( \$conf ); 81 | $buf = Log::Log4perl::Appender::TestBuffer->by_name("Buffer"); 82 | 83 | DEBUG "blah\n"; 84 | DEBUG "blah\n"; 85 | like($buf->buffer(), qr/blah foo /); 86 | 87 | done_testing; 88 | -------------------------------------------------------------------------------- /t/058Warnings.t: -------------------------------------------------------------------------------- 1 | 2 | BEGIN { 3 | if($ENV{INTERNAL_DEBUG}) { 4 | require Log::Log4perl::InternalDebug; 5 | Log::Log4perl::InternalDebug->enable(); 6 | } 7 | } 8 | 9 | use Test::More; 10 | use Log::Log4perl qw(:nostrict); 11 | my $warnings; 12 | 13 | $SIG{__WARN__} = sub { 14 | $warnings .= $_[0]; 15 | }; 16 | 17 | my $EG_DIR = "eg"; 18 | $EG_DIR = "../eg" unless -d $EG_DIR; 19 | 20 | Log::Log4perl->init( "$EG_DIR/dupe-warning.conf" ); 21 | 22 | is($warnings, undef, "no warnings"); 23 | 24 | done_testing; 25 | -------------------------------------------------------------------------------- /t/059Wrapper.t: -------------------------------------------------------------------------------- 1 | ############################################ 2 | # Tests for Log4perl used by a wrapper class 3 | # Mike Schilli, 2009 (m@perlmeister.com) 4 | ########################################### 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | use strict; 14 | use warnings; 15 | use Log::Log4perl qw(:easy); 16 | use Test::More; 17 | 18 | ########################################### 19 | package L4p::RelayWrapper; 20 | ########################################### 21 | no strict qw(refs); 22 | sub get_logger; 23 | Log::Log4perl->wrapper_register(__PACKAGE__); 24 | 25 | *get_logger = sub { 26 | 27 | my @args = @_; 28 | 29 | local $Log::Log4perl::caller_depth = 30 | $Log::Log4perl::caller_depth + 1; 31 | 32 | if(defined $args[0] and $args[0] eq __PACKAGE__) { 33 | my $pkg = __PACKAGE__; 34 | $args[0] =~ s/$pkg/Log::Log4perl/g; 35 | } 36 | Log::Log4perl::get_logger( @args ); 37 | }; 38 | 39 | ########################################### 40 | package L4p::InheritWrapper; 41 | ########################################### 42 | our @ISA = qw(Log::Log4perl); 43 | Log::Log4perl->wrapper_register(__PACKAGE__); 44 | 45 | ########################################### 46 | package main; 47 | ########################################### 48 | 49 | use Log::Log4perl qw(get_logger); 50 | 51 | my $pkg = "Wobble::Cobble"; 52 | my $pkgcat = "Wobble.Cobble"; 53 | 54 | my $logger; 55 | 56 | $logger = get_logger(); 57 | is $logger->{category}, "main", "imported get_logger()"; 58 | 59 | $logger = get_logger( $pkg ); 60 | is $logger->{category}, $pkgcat, "imported get_logger($pkg)"; 61 | 62 | for my $class (qw(Log::Log4perl 63 | L4p::RelayWrapper 64 | L4p::InheritWrapper)) { 65 | 66 | no strict 'refs'; 67 | 68 | my $func = "$class\::get_logger"; 69 | 70 | if($class !~ /Inherit/) { 71 | # wrap::() 72 | $logger = $func->(); 73 | is $logger->{category}, "main", "$class\::()"; 74 | 75 | $logger = $func->( $pkg ); 76 | is $logger->{category}, $pkgcat, "$class\::($pkg)"; 77 | } 78 | 79 | # wrap->() 80 | $logger = $class->get_logger(); 81 | is $logger->{category}, "main", "$class->()"; 82 | 83 | $logger = $class->get_logger($pkg); 84 | is $logger->{category}, $pkgcat, "$class->($pkg)"; 85 | } 86 | 87 | # use Data::Dumper; 88 | # print Dumper($logger; 89 | 90 | done_testing; 91 | -------------------------------------------------------------------------------- /t/060Initialized.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if($ENV{INTERNAL_DEBUG}) { 3 | require Log::Log4perl::InternalDebug; 4 | Log::Log4perl::InternalDebug->enable(); 5 | } 6 | } 7 | 8 | use strict; 9 | use warnings; 10 | use Test::More; 11 | use Log::Log4perl; 12 | use Log::Log4perl::Appender::TestBuffer; 13 | 14 | eval { 15 | Log::Log4perl->init('nonexistant_file'); 16 | }; 17 | 18 | ok((not Log::Log4perl->initialized()), 'Failed init doesn\'t flag initialized'); 19 | 20 | Log::Log4perl->reset(); 21 | 22 | eval { 23 | Log::Log4perl->init_once('nonexistant_file'); 24 | }; 25 | 26 | ok((not Log::Log4perl->initialized()), 'Failed init_once doesn\'t flag ' 27 | .'initialized'); 28 | 29 | Log::Log4perl->reset(); 30 | 31 | eval { 32 | Log::Log4perl->init(\ <initialized(), 'init flags initialized'); 41 | 42 | done_testing; 43 | -------------------------------------------------------------------------------- /t/061Multiline.t: -------------------------------------------------------------------------------- 1 | # https://rt.cpan.org/Public/Bug/Display.html?id=60197 2 | 3 | use Log::Log4perl; 4 | use Log::Log4perl::Appender; 5 | use Log::Log4perl::Appender::File; 6 | use Log::Log4perl::Layout::PatternLayout::Multiline; 7 | 8 | use Test::More; 9 | 10 | my $logger = Log::Log4perl->get_logger("blah"); 11 | 12 | my $layout = Log::Log4perl::Layout::PatternLayout::Multiline->new; 13 | 14 | my $logfile = "./file.log"; 15 | 16 | my $appender = Log::Log4perl::Appender->new( 17 | "Log::Log4perl::Appender::File", 18 | name => 'foo', 19 | filename => './file.log', 20 | mode => 'append', 21 | autoflush => 1, 22 | ); 23 | 24 | # Set the appender's layout 25 | $appender->layout($layout); 26 | $logger->add_appender($appender); 27 | 28 | # this message will be split into [], leading to undef being logged, 29 | # which will cause most appenders (e.g. ::File) to warn 30 | $appender->log({ level => 1, message => "\n\n" }, 'foo_category', 'INFO'); 31 | 32 | ok(1, "no warnings should appear here"); 33 | 34 | unlink $logfile; 35 | 36 | done_testing; 37 | -------------------------------------------------------------------------------- /t/062InitHash.t: -------------------------------------------------------------------------------- 1 | # https://rt.cpan.org/Public/Bug/Display.html?id=68105 2 | 3 | my $logfile = "test.log"; 4 | END { unlink $logfile; } 5 | 6 | use Log::Log4perl; 7 | use Log::Log4perl::Appender; 8 | use Log::Log4perl::Appender::File; 9 | 10 | use Test::More; 11 | 12 | Log::Log4perl->init({ 13 | 'log4perl.rootLogger' => 'ALL, FILE', 14 | 'log4perl.appender.FILE' => 15 | 'Log::Log4perl::Appender::File', 16 | 'log4perl.appender.FILE.filename' => sub { "$logfile" }, 17 | 'log4perl.appender.FILE.layout' => 'SimpleLayout', 18 | }); 19 | 20 | Log::Log4perl->get_logger->debug('yee haw'); 21 | 22 | open FILE, "<$logfile" or die $!; 23 | my $data = join '', ; 24 | close FILE; 25 | 26 | is( $data, "DEBUG - yee haw\n", "hash-init with subref" ); 27 | 28 | done_testing; 29 | -------------------------------------------------------------------------------- /t/063LoggerRemove.t: -------------------------------------------------------------------------------- 1 | # http://stackoverflow.com/questions/5914088 and 2 | # https://github.com/mschilli/log4perl/issues/7 3 | 4 | use strict; 5 | use Test::More; 6 | use Log::Log4perl::Appender::TestBuffer; 7 | 8 | use Log::Log4perl qw(get_logger :easy); 9 | 10 | # $Log::Log4perl::CHATTY_DESTROY_METHODS = 1; 11 | 12 | my $conf = q( 13 | log4perl.category.main = WARN, LogBuffer 14 | log4perl.category.Bar.Twix = WARN, LogBuffer 15 | log4perl.appender.LogBuffer = Log::Log4perl::Appender::TestBuffer 16 | log4perl.appender.LogBuffer.layout = \ 17 | Log::Log4perl::Layout::PatternLayout 18 | log4perl.appender.LogBuffer.layout.ConversionPattern = %d %F{1} %L> %m %n 19 | ); 20 | 21 | Log::Log4perl::init(\$conf); 22 | 23 | my $buffer = Log::Log4perl::Appender::TestBuffer->by_name("LogBuffer"); 24 | 25 | my $logger = get_logger("Bar::Twix"); 26 | 27 | ok(exists $Log::Log4perl::Logger::LOGGERS_BY_NAME->{"Bar.Twix"}, 28 | "logger exists"); 29 | 30 | Log::Log4perl->remove_logger( $logger ); 31 | undef $logger; 32 | 33 | ok(!exists $Log::Log4perl::Logger::LOGGERS_BY_NAME->{"Bar.Twix"}, 34 | "logger gone"); 35 | 36 | # now remove a stealth logger 37 | $logger = get_logger("main"); 38 | 39 | ok(exists $Log::Log4perl::Logger::LOGGERS_BY_NAME->{"main"}, 40 | "logger exists"); 41 | 42 | WARN "before"; 43 | 44 | Log::Log4perl->remove_logger( $logger ); 45 | undef $logger; 46 | 47 | ok(!exists $Log::Log4perl::Logger::LOGGERS_BY_NAME->{"main"}, 48 | "logger gone"); 49 | 50 | # this should be a no-op now. 51 | WARN "after"; 52 | 53 | like($buffer->buffer, qr/before/, "log message before logger removal present"); 54 | unlike($buffer->buffer, qr/after/, "log message after logger removal absent"); 55 | 56 | done_testing; 57 | -------------------------------------------------------------------------------- /t/064RealClass.t: -------------------------------------------------------------------------------- 1 | # get_logger($self) in the base class returns a logger for the subclass 2 | # category 3 | 4 | use strict; 5 | use Test::More; 6 | use Log::Log4perl::Appender::TestBuffer; 7 | 8 | package AppBaseClass; 9 | use Log::Log4perl qw(get_logger :easy); 10 | sub meth { 11 | my( $self ) = @_; 12 | get_logger( ref $self )->warn("in base class"); 13 | } 14 | 15 | package AppSubClass; 16 | our @ISA = qw(AppBaseClass); 17 | use Log::Log4perl qw(get_logger :easy); 18 | sub new { 19 | bless {}, shift; 20 | } 21 | 22 | package main; 23 | 24 | use Log::Log4perl qw(get_logger :easy); 25 | 26 | # $Log::Log4perl::CHATTY_DESTROY_METHODS = 1; 27 | 28 | my $conf = q( 29 | log4perl.category.AppSubClass = WARN, LogBuffer 30 | log4perl.appender.LogBuffer = Log::Log4perl::Appender::TestBuffer 31 | log4perl.appender.LogBuffer.layout = Log::Log4perl::Layout::PatternLayout 32 | log4perl.appender.LogBuffer.layout.ConversionPattern = %m%n 33 | ); 34 | 35 | Log::Log4perl::init(\$conf); 36 | 37 | my $buffer = Log::Log4perl::Appender::TestBuffer->by_name("LogBuffer"); 38 | 39 | my $sub = AppSubClass->new(); 40 | $sub->meth(); 41 | 42 | is $buffer->buffer(), "in base class\n", "subclass logger in base class"; 43 | 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/065Undef.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use File::Temp qw( tempfile ); 3 | use Test::More; 4 | use Log::Log4perl qw( :easy ); 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | my($tmpfh, $tempfile) = tempfile( UNLINK => 1 ); 14 | 15 | Log::Log4perl->easy_init( { level => $DEBUG, file => $tempfile } ); 16 | 17 | my $warnings = ""; 18 | 19 | $SIG{__WARN__} = sub { 20 | $warnings .= $_[0]; 21 | }; 22 | 23 | DEBUG "foo", undef, "bar"; 24 | 25 | like $warnings, qr/Log message argument #2/, "warning for undef element issued"; 26 | 27 | done_testing; 28 | -------------------------------------------------------------------------------- /t/066SQLite.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Test DBI appender with SQLite 3 | ########################################### 4 | 5 | our $table_name = "log4perltest$$"; 6 | 7 | BEGIN { 8 | if($ENV{INTERNAL_DEBUG}) { 9 | require Log::Log4perl::InternalDebug; 10 | Log::Log4perl::InternalDebug->enable(); 11 | } 12 | } 13 | 14 | use Test::More; 15 | use Log::Log4perl; 16 | use warnings; 17 | use strict; 18 | use File::Spec; 19 | use lib File::Spec->catdir(qw(t lib)); 20 | use Log4perlInternalTest qw(tmpdir min_version); 21 | 22 | BEGIN { 23 | min_version(qw( DBI DBD::SQLite )); 24 | } 25 | 26 | my $testdir = tmpdir(); 27 | 28 | my $dbfile = "$testdir/sqlite.dat"; 29 | 30 | require DBI; 31 | 32 | my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","",""); 33 | 34 | # https://rt.cpan.org/Public/Bug/Display.html?id=79960 35 | # undef as NULL 36 | my $stmt = <do($stmt) || die "do failed on $stmt".$dbh->errstr; 45 | 46 | my $config = <<"EOT"; 47 | log4j.category = WARN, DBAppndr 48 | log4j.appender.DBAppndr = Log::Log4perl::Appender::DBI 49 | log4j.appender.DBAppndr.datasource = dbi:SQLite:dbname=$dbfile 50 | log4j.appender.DBAppndr.sql = \\ 51 | insert into $table_name \\ 52 | (loglevel, mdc, message) \\ 53 | values (?, ?, ?) 54 | log4j.appender.DBAppndr.params.1 = %p 55 | log4j.appender.DBAppndr.params.2 = %X{foo} 56 | #---------------------------- #3 is message 57 | 58 | log4j.appender.DBAppndr.usePreparedStmt=2 59 | log4j.appender.DBAppndr.warp_message=0 60 | 61 | #noop layout to pass it through 62 | log4j.appender.DBAppndr.layout = Log::Log4perl::Layout::NoopLayout 63 | EOT 64 | 65 | Log::Log4perl::init(\$config); 66 | 67 | my $logger = Log::Log4perl->get_logger(); 68 | $logger->warn('test message'); 69 | 70 | my $ary_ref = $dbh->selectall_arrayref( "SELECT * from $table_name" ); 71 | is_deeply $ary_ref->[0], ["WARN", "test message", undef], "data logged in db"; 72 | 73 | $Log::Log4perl::Config::CONFIG_INTEGRITY_CHECK = 0; # to close handles and allow temp files to go 74 | Log::Log4perl::init(\''); 75 | 76 | done_testing; 77 | -------------------------------------------------------------------------------- /t/067Exception.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use File::Temp qw( tempfile ); 3 | use Log::Log4perl qw( get_logger ); 4 | use Test::More; 5 | 6 | BEGIN { 7 | if($ENV{INTERNAL_DEBUG}) { 8 | require Log::Log4perl::InternalDebug; 9 | Log::Log4perl::InternalDebug->enable(); 10 | } 11 | } 12 | 13 | eval { 14 | foo(); 15 | }; 16 | 17 | like $@, qr/main::foo/, "stacktrace on internal error"; 18 | done_testing; 19 | 20 | sub foo { 21 | Log::Log4perl::Logger->cleanup(); 22 | my $logger = get_logger(); 23 | } 24 | -------------------------------------------------------------------------------- /t/068MultilineIndented.t: -------------------------------------------------------------------------------- 1 | my $logfile = "./file.log"; 2 | END { unlink $logfile; } 3 | 4 | use Log::Log4perl; 5 | use Log::Log4perl::Appender; 6 | use Log::Log4perl::Appender::File; 7 | use Log::Log4perl::Layout::PatternLayout; 8 | 9 | use Test::More; 10 | 11 | my $logger = Log::Log4perl->get_logger("blah"); 12 | 13 | # 1 19 14 | # | | 15 | # %d : yyyy/mm/dd hh:mm:ss 16 | my $layout = Log::Log4perl::Layout::PatternLayout->new("%d > %m{indent}%n"); 17 | 18 | my $appender = Log::Log4perl::Appender->new( 19 | "Log::Log4perl::Appender::File", 20 | name => 'foo', 21 | filename => './file.log', 22 | mode => 'append', 23 | autoflush => 1, 24 | ); 25 | 26 | # Set the appender's layout 27 | $appender->layout($layout); 28 | $logger->add_appender($appender); 29 | 30 | my $msg =<<"EOF_MSG"; 31 | This is 32 | a message with 33 | multiple lines 34 | EOF_MSG 35 | 36 | chomp($msg); 37 | 38 | $appender->log({ level => 1, message => $msg }, 'foo_category', 'INFO'); 39 | 40 | # TEST : 41 | # 42 | # Just one test if format of log file is correct. 43 | # Any error of check_log_file_format() is returned as non empty string and 44 | # appended to $test_name to explain what went wrong. 45 | # 46 | my $err_str = check_log_file_format($logfile); 47 | my $test_name = 'log file has multiline intended format' . ($err_str ? " - reason : $err_str" : ""); 48 | ok ( ! $err_str, $test_name ); 49 | 50 | done_testing; 51 | 52 | # returns "" on success 53 | # returns non empty error string on failure 54 | sub check_log_file_format { 55 | my $logfile = shift; 56 | 57 | my $err_str = ""; 58 | my $line_count = 1; 59 | open(my $fh, "<", $logfile) || return "could not open log file '$logfile'"; 60 | 61 | for my $line (<$fh>) { 62 | if ($line_count == 1) { 63 | # 1 19 64 | # | | 65 | # yyyy/mm/dd hh:mm:ss > %m 66 | unless ( $line =~ m!^\d{4}/\d{2}/\d{2} \d{2}:\d{2}:\d{2} > This is\s*$! ) { 67 | $err_str = "first line wrong, should be: yyyy/mm/dd hh::mm::ss This is" ; 68 | last; 69 | } 70 | } 71 | else { 72 | unless ( $line =~ /^ {22}\S/ ) { 73 | $err_str = "format of line $line_count wrong"; 74 | last; 75 | } 76 | } 77 | $line_count++; 78 | } 79 | 80 | close($fh); 81 | 82 | return $err_str; 83 | } 84 | -------------------------------------------------------------------------------- /t/069MoreMultiline.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | my $logfile = "./file.log"; 5 | END { unlink $logfile; } 6 | 7 | use Log::Log4perl; 8 | use Log::Log4perl::Appender; 9 | use Log::Log4perl::Appender::TestBuffer; 10 | use Log::Log4perl::Layout::PatternLayout; 11 | use Test::More; 12 | 13 | my $logger = Log::Log4perl->get_logger("blah"); 14 | 15 | my $appender = Log::Log4perl::Appender->new( 16 | "Log::Log4perl::Appender::TestBuffer", 17 | name => 'testbuffer', 18 | ); 19 | $logger->add_appender($appender); 20 | 21 | my $msg = "line1\nline2\nline3\n"; 22 | my $logit = sub { 23 | $appender->log({ level => 1, message => $msg }, 'foo_category', 'INFO'); 24 | }; 25 | 26 | # indent=fix 27 | my $layout = Log::Log4perl::Layout::PatternLayout->new("%m{indent=2}"); 28 | $appender->layout($layout); 29 | $logit->(); 30 | is $appender->buffer(), "line1\n line2\n line3\n ", "indent=2"; 31 | $appender->buffer(""); 32 | 33 | # indent=fix,chomp 34 | $layout = Log::Log4perl::Layout::PatternLayout->new("%m{indent=2,chomp}"); 35 | $appender->layout($layout); 36 | $logit->(); 37 | is $appender->buffer(), "line1\n line2\n line3", "indent=2,chomp"; 38 | $appender->buffer(""); 39 | 40 | # indent=variable 41 | $layout = Log::Log4perl::Layout::PatternLayout->new("123%m{indent}"); 42 | $appender->layout($layout); 43 | $logit->(); 44 | is $appender->buffer(), "123line1\n line2\n line3\n ", "indent"; 45 | $appender->buffer(""); 46 | 47 | # indent=variable,chomp 48 | $layout = Log::Log4perl::Layout::PatternLayout->new("123%m{indent,chomp}"); 49 | $appender->layout($layout); 50 | $logit->(); 51 | #print "[", $appender->buffer(), "]\n"; 52 | is $appender->buffer(), "123line1\n line2\n line3", "indent,chomp"; 53 | $appender->buffer(""); 54 | 55 | done_testing; 56 | -------------------------------------------------------------------------------- /t/070UTCDate.t: -------------------------------------------------------------------------------- 1 | ########################################### 2 | # Tests for Log4perl::DateFormat with gmtime 3 | ########################################### 4 | 5 | BEGIN { 6 | if($ENV{INTERNAL_DEBUG}) { 7 | require Log::Log4perl::InternalDebug; 8 | Log::Log4perl::InternalDebug->enable(); 9 | } 10 | } 11 | 12 | use strict; 13 | use warnings; 14 | use Test::More; 15 | use Log::Log4perl qw(get_logger); 16 | use Log::Log4perl::Appender::TestBuffer; 17 | 18 | sub init_with_utc { 19 | my ($utc) = @_; 20 | my $conf = <<'CONF'; 21 | log4perl.category.Bar.Twix = WARN, Buffer 22 | log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer 23 | log4perl.appender.Buffer.layout = \ 24 | Log::Log4perl::Layout::PatternLayout 25 | log4perl.appender.Buffer.layout.ConversionPattern = %d{HH:mm:ss}%n 26 | CONF 27 | if (defined $utc) { 28 | $conf .= "log4perl.utcDateTimes = $utc\n"; 29 | } 30 | 31 | Log::Log4perl::init(\$conf); 32 | } 33 | 34 | init_with_utc(1); 35 | ok $Log::Log4perl::DateFormat::GMTIME, "init_with_utc"; 36 | 37 | init_with_utc(0); 38 | ok ! $Log::Log4perl::DateFormat::GMTIME, "init_with_utc"; 39 | 40 | done_testing; 41 | -------------------------------------------------------------------------------- /t/071ScreenStdoutStderr.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if($ENV{INTERNAL_DEBUG}) { 3 | require Log::Log4perl::InternalDebug; 4 | Log::Log4perl::InternalDebug->enable(); 5 | } 6 | } 7 | 8 | use warnings; 9 | use strict; 10 | 11 | use Log::Log4perl qw(:easy :no_extra_logdie_message); 12 | use Test::More; 13 | use File::Spec; 14 | use lib File::Spec->catdir(qw(t lib)); 15 | use Log4perlInternalTest qw(tmpdir); 16 | 17 | BEGIN { 18 | if ($] < 5.008) { 19 | plan skip_all => "Only with perl >= 5.008"; 20 | } else { 21 | plan tests => 30; 22 | } 23 | } 24 | 25 | ######################################################################### 26 | # Capture STDERR to a temporary file and a filehandle to read from it 27 | 28 | ++$|; 29 | my $WORK_DIR = tmpdir(); 30 | my $TMP_FILE_STDOUT = File::Spec->catfile($WORK_DIR, qw(stdout)); 31 | my $TMP_FILE_STDERR = File::Spec->catfile($WORK_DIR, qw(stderr)); 32 | 33 | open STDOUT, '>', $TMP_FILE_STDOUT; 34 | open STDERR, '>', $TMP_FILE_STDERR; 35 | open IN_STDOUT, '<', $TMP_FILE_STDOUT or die "Cannot open $TMP_FILE_STDOUT"; binmode IN_STDOUT, ":utf8"; 36 | open IN_STDERR, '<', $TMP_FILE_STDERR or die "Cannot open $TMP_FILE_STDERR"; binmode IN_STDERR, ":utf8"; 37 | sub readstdout { IN_STDOUT->clearerr(); return join("", ); } 38 | sub readstderr { IN_STDERR->clearerr(); return join("", ); } 39 | 40 | END { unlink $TMP_FILE_STDOUT; 41 | unlink $TMP_FILE_STDERR; 42 | close IN_STDOUT; 43 | close IN_STDERR; 44 | } 45 | ######################################################################### 46 | 47 | # Tests for all stdout 48 | my %tests = ( 49 | debug => { stderr => 0, code => \&DEBUG }, 50 | info => { stderr => 0, code => \&INFO }, 51 | warn => { stderr => 0, code => \&WARN }, 52 | error => { stderr => 0, code => \&ERROR }, 53 | fatal => { stderr => 0, code => \&FATAL }, 54 | ); 55 | 56 | my $conf = qq( 57 | log4perl.category = DEBUG, Screen 58 | 59 | # Regular Screen Appender 60 | log4perl.appender.Screen = Log::Log4perl::Appender::Screen 61 | log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout 62 | log4perl.appender.Screen.stderr = 0 63 | ); 64 | 65 | do_tests( $conf, \%tests ); 66 | 67 | # Test for all stderr - reset our captures and set stderr to 1 68 | truncate STDOUT, 0; 69 | truncate STDERR, 0; 70 | ++$tests{ $_ }{stderr} for (keys %tests); 71 | 72 | $conf = qq( 73 | log4perl.category = DEBUG, Screen 74 | 75 | # Regular Screen Appender 76 | log4perl.appender.Screen = Log::Log4perl::Appender::Screen 77 | log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout 78 | log4perl.appender.Screen.stderr = 1 79 | ); 80 | 81 | do_tests( $conf, \%tests ); 82 | 83 | # Tests for mixed stdout and stderr - reset our captures and set some to stdout 84 | truncate STDOUT, 0; 85 | truncate STDERR, 0; 86 | --$tests{debug}{stderr}; 87 | --$tests{info}{stderr}; 88 | --$tests{warn}{stderr}; 89 | 90 | $conf = qq( 91 | log4perl.category = DEBUG, Screen 92 | 93 | # Regular Screen Appender 94 | log4perl.appender.Screen = Log::Log4perl::Appender::Screen 95 | log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout 96 | log4perl.appender.Screen.stderr.ERROR = 1 97 | # Lower case test 98 | log4perl.appender.Screen.stderr.fatal = 1 99 | ); 100 | 101 | do_tests( $conf, \%tests ); 102 | 103 | sub do_tests { 104 | my ($conf, $tests) = @_; 105 | 106 | Log::Log4perl->init(\$conf); 107 | 108 | for my $level (sort keys %{ $tests }) { 109 | # e.g. "DEBUG('debug')" 110 | $tests->{ $level }{code}->( $level ); 111 | is( readstdout() =~ /$level/ ? 0 : 1, $tests->{ $level }{stderr}, $level . ' to stdout'); 112 | is( readstderr() =~ /$level/ ? 1 : 0, $tests->{ $level }{stderr}, $level . ' to stderr'); 113 | } 114 | } 115 | -------------------------------------------------------------------------------- /t/deeper1.expected: -------------------------------------------------------------------------------- 1 | INFO plant N/A - info message 1 2 | WARN plant N/A - warning message 1 3 | FATAL plant N/A - fatal message 1 4 | DEBUG animal.dog N/A - debugging message 2 5 | INFO animal.dog N/A - info message 2 6 | WARN animal.dog N/A - warning message 2 7 | FATAL animal.dog N/A - fatal message 2 8 | INFO animal N/A - info message 3 9 | WARN animal N/A - warning message 3 10 | FATAL animal N/A - fatal message 3 11 | DEBUG animal.dog.leg.toenail N/A - debug message 12 | INFO animal N/A - info message 13 | WARN animal.dog.leg.toenail N/A - warning message 14 | FATAL animal N/A - fatal message 15 | -------------------------------------------------------------------------------- /t/deeper6.expected: -------------------------------------------------------------------------------- 1 | INFO a - should print for a, a.b, a.b.c 2 | INFO a.b - should print for a, a.b, a.b.c 3 | INFO a.b.c - should print for a, a.b, a.b.c 4 | WARN a - should print for a, a.b, a.b.c, a.b.c.d, a.b.c.d.e 5 | WARN a.b - should print for a, a.b, a.b.c, a.b.c.d, a.b.c.d.e 6 | WARN a.b.c - should print for a, a.b, a.b.c, a.b.c.d, a.b.c.d.e 7 | WARN a.b.c.d - should print for a, a.b, a.b.c, a.b.c.d, a.b.c.d.e 8 | WARN a.b.c.d.e - should print for a, a.b, a.b.c, a.b.c.d, a.b.c.d.e 9 | FATAL a - should print for a, a.b, a.b.c, a.b.c.d, a.b.c.d.e 10 | FATAL a.b - should print for a, a.b, a.b.c, a.b.c.d, a.b.c.d.e 11 | FATAL a.b.c - should print for a, a.b, a.b.c, a.b.c.d, a.b.c.d.e 12 | FATAL a.b.c.d - should print for a, a.b, a.b.c, a.b.c.d, a.b.c.d.e 13 | FATAL a.b.c.d.e - should print for a, a.b, a.b.c, a.b.c.d, a.b.c.d.e 14 | -------------------------------------------------------------------------------- /t/deeper7.expected: -------------------------------------------------------------------------------- 1 | INFO xa.b.c.d - should print for xa.b.c.d, xa.b.c.d.e 2 | INFO xa.b.c.d.e - should print for xa.b.c.d, xa.b.c.d.e 3 | WARN xa - should print for xa, xa.b, xa.b.c, xa.b.c.d, xa.b.c.d.e 4 | WARN xa.b - should print for xa, xa.b, xa.b.c, xa.b.c.d, xa.b.c.d.e 5 | WARN xa.b.c - should print for xa, xa.b, xa.b.c, xa.b.c.d, xa.b.c.d.e 6 | WARN xa.b.c.d - should print for xa, xa.b, xa.b.c, xa.b.c.d, xa.b.c.d.e 7 | WARN xa.b.c.d.e - should print for xa, xa.b, xa.b.c, xa.b.c.d, xa.b.c.d.e 8 | FATAL xa - should print for xa, xa.b, xa.b.c, xa.b.c.d, xa.b.c.d.e 9 | FATAL xa.b - should print for xa, xa.b, xa.b.c, xa.b.c.d, xa.b.c.d.e 10 | FATAL xa.b.c - should print for xa, xa.b, xa.b.c, xa.b.c.d, xa.b.c.d.e 11 | FATAL xa.b.c.d - should print for xa, xa.b, xa.b.c, xa.b.c.d, xa.b.c.d.e 12 | FATAL xa.b.c.d.e - should print for xa, xa.b, xa.b.c, xa.b.c.d, xa.b.c.d.e 13 | -------------------------------------------------------------------------------- /t/testdisp.pl: -------------------------------------------------------------------------------- 1 | ################################################## 2 | # String dispatcher for testing 3 | ################################################## 4 | 5 | package Log::Dispatch::String; 6 | 7 | use Log::Dispatch::Output; 8 | use base qw( Log::Dispatch::Output ); 9 | use fields qw( stderr ); 10 | 11 | sub new 12 | { 13 | my $proto = shift; 14 | my $class = ref $proto || $proto; 15 | my %params = @_; 16 | 17 | my $self = bless {}, $class; 18 | 19 | $self->_basic_init(%params); 20 | $self->{stderr} = exists $params{stderr} ? $params{stderr} : 1; 21 | $self->{buffer} = ""; 22 | 23 | return $self; 24 | } 25 | 26 | sub log_message 27 | { 28 | my $self = shift; 29 | my %params = @_; 30 | 31 | $self->{buffer} .= $params{message}; 32 | } 33 | 34 | sub buffer 35 | { 36 | my($self, $new) = @_; 37 | 38 | if(defined $new) { 39 | $self->{buffer} = $new; 40 | } 41 | 42 | return $self->{buffer}; 43 | } 44 | 45 | sub reset 46 | { 47 | my($self) = @_; 48 | 49 | $self->{buffer} = ""; 50 | } 51 | 52 | 1; 53 | -------------------------------------------------------------------------------- /xml/log4perl.dtd: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | %log4j.dtd; 11 | 12 | 13 | 15 | 17 | 18 | 24 | 25 | 26 | 28 | 30 | 35 | 36 | 37 | 38 | 41 | 42 | 43 | 45 | 46 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 58 | 59 | 60 | 61 | 64 | 65 | 68 | 69 | 74 | 75 | 76 | 77 | 78 | --------------------------------------------------------------------------------