t/039XML-DOM2.t - metacpan.org


our $table_name = "log4perltest$$";

BEGIN { 
    if($ENV{INTERNAL_DEBUG}) {
        require Log::Log4perl::InternalDebug;
        Log::Log4perl::InternalDebug->enable();
    }
}

use Test::More;
use Log::Log4perl;
use strict;

our $no_XMLDOM;

BEGIN {
    my $dvrq = $Log::Log4perl::DOM_VERSION_REQUIRED;
    eval {
        require XML::DOM;
        my $dver = XML::DOM->VERSION($dvrq);
        require XML::Parser;
        my $pver = XML::Parser->VERSION;
        if ($pver >= 2.32 && $dver <= 1.42){
            print STDERR "Your version of XML::DOM ($dver) is incompatible with your version of XML::Parser ($pver).  You should upgrade your XML::DOM to 1.43 or greater.\n";
            die 'skip tests';
        }
    };
    if ($@) {
        plan skip_all => "only with XML::DOM > $dvrq";
    }else{
        plan tests => 4;
    }
}

if ($no_XMLDOM){
    ok(1);
    exit(0);
}


my $xmlconfig = <<EOL;
<?xml version="1.0" encoding="UTF-8"?> 
<!DOCTYPE log4perl:configuration SYSTEM "log4perl.dtd">

<log4perl:configuration xmlns:log4perl="http://log4perl.sourceforge.net/"
    threshold="debug" oneMessagePerAppender="true">
    
<log4perl:appender name="jabbender" class="Log::Dispatch::Jabber">
          <param-nested name="login">
                <param name="hostname" value="a.jabber.server"/>
                <param name="password" value="12345"/>
                <param name="port" value="5222"/>
                <param name="resource" value="logger"/>
                <param name="username" value="bobjones"/>
         </param-nested>
         <param name="to" value="bob\@a.jabber.server"/>
         <param-text name="to">mary\@another.jabber.server</param-text>
          <layout class="Log::Log4perl::Layout::SimpleLayout"/>
         
</log4perl:appender>
<log4perl:appender name="DBAppndr2" class="Log::Log4perl::Appender::DBI">
          <param name="warp_message" value="0"/>
          <param name="datasource" value="DBI:CSV:f_dir=t/tmp"/>
          <param name="bufferSize" value="2"/>
          <param name="password" value="sub { \$ENV{PWD} }"/>
           <param name="username" value="bobjones"/>
          
          <param-text name="sql">insert into $table_name (loglevel, message, shortcaller, thingid, category, pkg, runtime1, runtime2) values (?,?,?,?,?,?,?,?)</param-text> 
           <param-nested name="params">
                <param name="1" value="%p"/>
                <param name="3" value="%5.5l"/>
                <param name="5" value="%c"/>
                <param name="6" value="%C"/>
           </param-nested>
                
           <layout class="Log::Log4perl::Layout::NoopLayout"/>
         
</log4perl:appender>
<category name="animal.dog">
           <priority value="info"/>
           <appender-ref ref="jabbender"/>
</category>

<PatternLayout>
    <cspec name="G"><![CDATA[sub { return "UID \$< GID \$("; }]]></cspec>
</PatternLayout>


</log4perl:configuration>
EOL


my $xmldata = Log::Log4perl::Config::config_read(\$xmlconfig);

my $propsconfig = <<EOL;

log4j.category.animal.dog   = INFO, jabbender
log4j.threshold = DEBUG

log4j.oneMessagePerAppender=1

log4j.PatternLayout.cspec.G=sub { return "UID \$< GID \$("; }

log4j.appender.jabbender          = Log::Dispatch::Jabber
log4j.appender.jabbender.layout   = Log::Log4perl::Layout::SimpleLayout
log4j.appender.jabbender.login.hostname = a.jabber.server
log4j.appender.jabbender.login.port = 5222
log4j.appender.jabbender.login.username = bobjones
log4j.appender.jabbender.login.password = 12345
log4j.appender.jabbender.login.resource = logger
log4j.appender.jabbender.to = bob\@a.jabber.server
log4j.appender.jabbender.to = mary\@another.jabber.server

log4j.appender.DBAppndr2             = Log::Log4perl::Appender::DBI
log4j.appender.DBAppndr2.username  = bobjones
log4j.appender.DBAppndr2.datasource = DBI:CSV:f_dir=t/tmp
log4j.appender.DBAppndr2.password = sub { \$ENV{PWD} }
log4j.appender.DBAppndr2.sql = insert into $table_name (loglevel, message, shortcaller, thingid, category, pkg, runtime1, runtime2) values (?,?,?,?,?,?,?,?)
log4j.appender.DBAppndr2.params.1 = %p    
log4j.appender.DBAppndr2.params.3 = %5.5l
log4j.appender.DBAppndr2.params.5 = %c
log4j.appender.DBAppndr2.params.6 = %C

log4j.appender.DBAppndr2.bufferSize=2
log4j.appender.DBAppndr2.warp_message=0
    
#noop layout to pass it through
log4j.appender.DBAppndr2.layout    = Log::Log4perl::Layout::NoopLayout


EOL



my $propsdata = Log::Log4perl::Config::config_read(\$propsconfig);

#brute force testing here, not very granular, but it is thorough

eval {require Data::Dump};
my $dump_available;
if (! $@) {
    $dump_available = 1;
}


require 't/compare.pl';

ok(Compare($xmldata, $propsdata)) || 
        do {
          if ($dump_available) {
              print STDERR "got: ",Data::Dump::dump($xmldata),"\n================\n";
              print STDERR "expected: ", Data::Dump::dump($propsdata),"\n";
          }
        };

# ------------------------------------------------
#ok, let's get more hairy, make-believe

$xmlconfig = <<'EOL';
<?xml version="1.0" encoding="UTF-8"?> 
<!DOCTYPE log4perl:configuration SYSTEM "log4perl.dtd">

<log4perl:configuration xmlns:log4perl="http://log4perl.sourceforge.net/">

<log4perl:appender name="A1" class="Log::Dispatch::Jabber">
          <param-nested name="A">
                <param-text name="1">fffff</param-text>
                <param name="list" value="11111"/>
                <param name="list" value="22222"/>
                <param-nested name="subnest">
                    <param-text name="a">hhhhh</param-text>
                    <param name="list" value="aaaaa"/>
                    <param name="list" value="bbbbb"/>
                </param-nested>
         </param-nested>
         <param-text name="to">mary@another.jabber.server</param-text>
          <layout class="Log::Log4perl::Layout::SimpleLayout"/>
</log4perl:appender>

</log4perl:configuration>

EOL

$propsconfig = <<'EOL';

log4j.appender.A1= Log::Dispatch::Jabber
log4j.appender.A1.A.1=fffff
log4j.appender.A1.A.list=11111
log4j.appender.A1.A.list=22222
log4j.appender.A1.A.subnest.a=hhhhh
log4j.appender.A1.A.subnest.list=aaaaa
log4j.appender.A1.A.subnest.list=bbbbb
log4j.appender.A1.to=mary@another.jabber.server
log4j.appender.A1.layout=Log::Log4perl::Layout::SimpleLayout
EOL

$xmldata = Log::Log4perl::Config::config_read(\$xmlconfig);
$propsdata = Log::Log4perl::Config::config_read(\$propsconfig);

ok(Compare($xmldata, $propsdata)) || 
        do {
          if ($dump_available) {
              print STDERR "got: ",Data::Dump::dump($xmldata),"\n================\n";
              print STDERR "expected: ", Data::Dump::dump($propsdata),"\n";
          }
        };


# ------------------------------------------------
#now testing things like cspecs, code refs

$xmlconfig = <<'EOL';
<?xml version="1.0" encoding="UTF-8"?> 
<!DOCTYPE log4perl:configuration SYSTEM "log4perl.dtd">

<log4perl:configuration xmlns:log4perl="http://log4perl.sourceforge.net/">



<log4perl:appender name="appndr1" class="Log::Log4perl::Appender::TestBuffer">
    <log4perl:layout class="org.apache.log4j.PatternLayout">
        <param name="ConversionPattern" value = "%K xx %G %U"/>
        <cspec name="K">
            sub { return sprintf "%1x", $$}
        </cspec>
        <cspec name="G">
            sub {return 'thisistheGcspec'}
        </cspec>
    </log4perl:layout>
</log4perl:appender>

<category name="plant">
        <priority value="debug"/>  
        <appender-ref ref="appndr1"/>
</category>

<PatternLayout>
    <cspec name="U"><![CDATA[
        sub {                       return "UID $< GID $("; }                          
    ]]></cspec>
</PatternLayout>



</log4perl:configuration>


EOL


$propsconfig = <<'EOL';
log4j.category.plant    = DEBUG, appndr1

log4j.PatternLayout.cspec.U =       \
        sub {                       \
            return "UID $< GID $("; \
        }                           \

log4j.appender.appndr1        = Log::Log4perl::Appender::TestBuffer
log4j.appender.appndr1.layout = org.apache.log4j.PatternLayout
log4j.appender.appndr1.layout.ConversionPattern = %K xx %G %U

log4j.appender.appndr1.layout.cspec.K = sub { return sprintf "%1x", $$}

log4j.appender.appndr1.layout.cspec.G = sub {return 'thisistheGcspec'}
EOL

$xmldata = Log::Log4perl::Config::config_read(\$xmlconfig);
$propsdata = Log::Log4perl::Config::config_read(\$propsconfig);

ok(Compare($xmldata, $propsdata)) || 
        do {
          if ($dump_available) {
              print STDERR "got: ",Data::Dump::dump($xmldata),"\n================\n";
              print STDERR "expected: ", Data::Dump::dump($propsdata),"\n";
          }
        };



#now we test variable substitution
#brute force again
my $varsubstconfig = <<'EOL';
<?xml version="1.0" encoding="UTF-8"?> 
<!DOCTYPE log4perl:configuration SYSTEM "log4perl.dtd">

<log4perl:configuration xmlns:log4perl="http://log4perl.sourceforge.net/"
    threshold="debug" oneMessagePerAppender="${onemsgperappnder}">
    
<log4perl:appender name="jabbender" class="${jabberclass}">
          <param-nested name="${paramnestedname}">
                <param name="${hostname}" value="${hostnameval}"/>
                <param name="${password}" value="${passwordval}"/>
                <param name="port" value="5222"/>
                <param name="resource" value="logger"/>
                <param name="username" value="bobjones"/>
         </param-nested>
         <param name="to" value="bob@a.jabber.server"/>
         <param-text name="to">${topcdata}</param-text>
          <layout class="Log::Log4perl::Layout::SimpleLayout"/>
         
</log4perl:appender>
<log4perl:appender name="DBAppndr2" class="Log::Log4perl::Appender::DBI">
          <param name="warp_message" value="0"/>
          <param name="datasource" value="DBI:CSV:f_dir=t/tmp"/>
          <param name="bufferSize" value="2"/>
          <param name="password" value="sub { $ENV{PWD} }"/>
           <param name="username" value="bobjones"/>
          
          <param-text name="sql">insert into ${tablename} (loglevel, message, shortcaller, thingid, category, pkg, runtime1, runtime2) values (?,?,?,?,?,?,?,?)</param-text> 
           <param-nested name="params">
                <param name="1" value="%p"/>
                <param name="3" value="%5.5l"/>
                <param name="5" value="%c"/>
                <param name="6" value="%C"/>
           </param-nested>
                
           <layout class="Log::Log4perl::Layout::NoopLayout"/>
         
</log4perl:appender>
<category name="animal.dog">
           <priority value="info"/>
           <appender-ref ref="jabbender"/>
</category>

<PatternLayout>
    <cspec name="${cspecname}"><![CDATA[sub { ${perlcode} }]]></cspec>
</PatternLayout>


</log4perl:configuration>
EOL

$ENV{onemsgperappnder} = 'true';
$ENV{jabberclass} = 'Log::Dispatch::Jabber';
$ENV{paramnestedname} = 'login';
$ENV{hostname} = 'hostname';
$ENV{hostnameval} = 'a.jabber.server';
$ENV{password} = 'password';
$ENV{passwordval} = '12345';
$ENV{topcdata} = 'mary@another.jabber.server';
$ENV{tablename} = $table_name;
$ENV{cspecname} = 'G';
$ENV{perlcode} = 'return "UID $< GID $(";';

my $varsubstdata = Log::Log4perl::Config::config_read(\$varsubstconfig);



ok(Compare($xmldata, $propsdata)) || 
        do {
          if ($dump_available) {
              print STDERR "got: ",Data::Dump::dump($xmldata),"\n================\n";
              print STDERR "expected: ", Data::Dump::dump($propsdata),"\n";
          }
        };
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)