Log-Log4perl-1.46HEADLog-Log4perl-1.46master

1 files changed, 1213 insertions, 0 deletions

diff --git a/lib/Log/Log4perl/Config.pm b/lib/Log/Log4perl/Config.pm
new file mode 100644
index 0000000..5a19df2
--- /dev/null
+++ b/lib/Log/Log4perl/Config.pm
@@ -0,0 +1,1213 @@
+##################################################
+package Log::Log4perl::Config;
+##################################################
+use 5.006;
+use strict;
+use warnings;
+
+use Log::Log4perl::Logger;
+use Log::Log4perl::Level;
+use Log::Log4perl::Config::PropertyConfigurator;
+use Log::Log4perl::JavaMap;
+use Log::Log4perl::Filter;
+use Log::Log4perl::Filter::Boolean;
+use Log::Log4perl::Config::Watch;
+
+use constant _INTERNAL_DEBUG => 0;
+
+our $CONFIG_FILE_READS       = 0;
+our $CONFIG_INTEGRITY_CHECK  = 1;
+our $CONFIG_INTEGRITY_ERROR  = undef;
+
+our $WATCHER;
+our $DEFAULT_WATCH_DELAY = 60; # seconds
+our $OPTS = {};
+our $OLD_CONFIG;
+our $LOGGERS_DEFINED;
+our $UTF8 = 0;
+
+###########################################
+sub init {
+###########################################
+    Log::Log4perl::Logger->reset();
+
+    undef $WATCHER; # just in case there's a one left over (e.g. test cases)
+
+    return _init(@_);
+}
+
+###########################################
+sub utf8 {
+###########################################
+    my( $class, $flag ) = @_;
+
+    $UTF8 = $flag if defined $flag;
+
+    return $UTF8;
+}
+
+###########################################
+sub watcher {
+###########################################
+    return $WATCHER;
+}
+
+###########################################
+sub init_and_watch {
+###########################################
+    my ($class, $config, $delay, $opts) = @_;
+        # delay can be a signal name - in this case we're gonna
+        # set up a signal handler.
+
+    if(defined $WATCHER) {
+        $config = $WATCHER->file();
+        if(defined $Log::Log4perl::Config::Watch::SIGNAL_CAUGHT) {
+            $delay  = $WATCHER->signal();
+        } else {
+            $delay  = $WATCHER->check_interval();
+        }
+    }
+
+    print "init_and_watch ($config-$delay). Resetting.\n" if _INTERNAL_DEBUG;
+
+    Log::Log4perl::Logger->reset();
+
+    defined ($delay) or $delay = $DEFAULT_WATCH_DELAY;  
+
+    if (ref $config) {
+        die "Log4perl can only watch a file, not a string of " .
+            "configuration information";
+    }elsif ($config =~ m!^(https?|ftp|wais|gopher|file):!){
+        die "Log4perl can only watch a file, not a url like $config";
+    }
+
+    if($delay =~ /\D/) {
+        $WATCHER = Log::Log4perl::Config::Watch->new(
+                          file         => $config,
+                          signal       => $delay,
+                          l4p_internal => 1,
+                   );
+    } else {
+        $WATCHER = Log::Log4perl::Config::Watch->new(
+                          file           => $config,
+                          check_interval => $delay,
+                          l4p_internal   => 1,
+                   );
+    }
+
+    if(defined $opts) {
+        die "Parameter $opts needs to be a hash ref" if ref($opts) ne "HASH";
+        $OPTS = $opts;
+    }
+
+    eval { _init($class, $config); };
+
+    if($@) {
+        die "$@" unless defined $OLD_CONFIG;
+            # Call _init with a pre-parsed config to go back to old setting
+        _init($class, undef, $OLD_CONFIG);
+        warn "Loading new config failed, reverted to old one\n";
+    }
+}
+
+##################################################
+sub _init {
+##################################################
+    my($class, $config, $data) = @_;
+
+    my %additivity = ();
+
+    $LOGGERS_DEFINED = 0;
+
+    print "Calling _init\n" if _INTERNAL_DEBUG;
+
+    #keep track so we don't create the same one twice
+    my %appenders_created = ();
+
+    #some appenders need to run certain subroutines right at the
+    #end of the configuration phase, when all settings are in place.
+    my @post_config_subs  = ();
+
+    # This logic is probably suited to win an obfuscated programming
+    # contest. It desperately needs to be rewritten.
+    # Basically, it works like this:
+    # config_read() reads the entire config file into a hash of hashes:
+    #     log4j.logger.foo.bar.baz: WARN, A1
+    # gets transformed into
+    #     $data->{log4j}->{logger}->{foo}->{bar}->{baz} = "WARN, A1";
+    # The code below creates the necessary loggers, sets the appenders
+    # and the layouts etc.
+    # In order to transform parts of this tree back into identifiers
+    # (like "foo.bar.baz"), we're using the leaf_paths functions below.
+    # Pretty scary. But it allows the lines of the config file to be
+    # in *arbitrary* order.
+
+    $data = config_read($config) unless defined $data;
+    
+    if(_INTERNAL_DEBUG) {
+        require Data::Dumper;
+        Data::Dumper->import();
+        print Data::Dumper::Dumper($data);
+    }
+
+    my @loggers      = ();
+    my %filter_names = ();
+
+    my $system_wide_threshold;
+
+      # Autocorrect the rootlogger/rootLogger typo
+    if(exists $data->{rootlogger} and 
+       ! exists $data->{rootLogger}) {
+         $data->{rootLogger} = $data->{rootlogger};
+    }
+
+        # Find all logger definitions in the conf file. Start
+        # with root loggers.
+    if(exists $data->{rootLogger}) {
+        $LOGGERS_DEFINED++;
+        push @loggers, ["", $data->{rootLogger}->{value}];
+    }
+        
+        # Check if we've got a system-wide threshold setting
+    if(exists $data->{threshold}) {
+            # yes, we do.
+        $system_wide_threshold = $data->{threshold}->{value};
+    }
+
+    if (exists $data->{oneMessagePerAppender}){
+                    $Log::Log4perl::one_message_per_appender = 
+                        $data->{oneMessagePerAppender}->{value};
+    }
+
+    if(exists $data->{utcDateTimes}) {
+        require Log::Log4perl::DateFormat;
+        $Log::Log4perl::DateFormat::GMTIME = !!$data->{utcDateTimes}->{value};
+    }
+
+        # Boolean filters 
+    my %boolean_filters = ();
+
+        # Continue with lower level loggers. Both 'logger' and 'category'
+        # are valid keywords. Also 'additivity' is one, having a logger
+        # attached. We'll differentiate between the two further down.
+    for my $key (qw(logger category additivity PatternLayout filter)) {
+
+        if(exists $data->{$key}) {
+
+            for my $path (@{leaf_paths($data->{$key})}) {
+
+                print "Path before: @$path\n" if _INTERNAL_DEBUG;
+
+                my $value = boolean_to_perlish(pop @$path);
+
+                pop @$path; # Drop the 'value' keyword part
+
+                if($key eq "additivity") {
+                    # This isn't a logger but an additivity setting.
+                    # Save it in a hash under the logger's name for later.
+                    $additivity{join('.', @$path)} = $value;
+
+                    #a global user-defined conversion specifier (cspec)
+                }elsif ($key eq "PatternLayout"){
+                    &add_global_cspec(@$path[-1], $value);
+
+                }elsif ($key eq "filter"){
+                    print "Found entry @$path\n" if _INTERNAL_DEBUG;
+                    $filter_names{@$path[0]}++;
+                } else {
+
+                    if (ref($value) eq "ARRAY") {
+                      die "Multiple definitions of logger ".join('.',@$path)." in log4perl config";
+                    }
+
+                    # This is a regular logger
+                    $LOGGERS_DEFINED++;
+                    push @loggers, [join('.', @$path), $value];
+                }
+            }
+        }
+    }
+
+        # Now go over all filters found by name
+    for my $filter_name (keys %filter_names) {
+
+        print "Checking filter $filter_name\n" if _INTERNAL_DEBUG;
+
+            # The boolean filter needs all other filters already
+            # initialized, defer its initialization
+        if($data->{filter}->{$filter_name}->{value} eq
+           "Log::Log4perl::Filter::Boolean") {
+            print "Boolean filter ($filter_name)\n" if _INTERNAL_DEBUG;
+            $boolean_filters{$filter_name}++;
+            next;
+        }
+
+        my $type = $data->{filter}->{$filter_name}->{value};
+        if(my $code = compile_if_perl($type)) {
+            $type = $code;
+        }
+        
+        print "Filter $filter_name is of type $type\n" if _INTERNAL_DEBUG;
+
+        my $filter;
+
+        if(ref($type) eq "CODE") {
+                # Subroutine - map into generic Log::Log4perl::Filter class
+            $filter = Log::Log4perl::Filter->new($filter_name, $type);
+        } else {
+                # Filter class
+                die "Filter class '$type' doesn't exist" unless
+                     Log::Log4perl::Util::module_available($type);
+                eval "require $type" or die "Require of $type failed ($!)";
+
+                # Invoke with all defined parameter
+                # key/values (except the key 'value' which is the entry 
+                # for the class)
+            $filter = $type->new(name => $filter_name,
+                map { $_ => $data->{filter}->{$filter_name}->{$_}->{value} } 
+                grep { $_ ne "value" } 
+                keys %{$data->{filter}->{$filter_name}});
+        }
+            # Register filter with the global filter registry
+        $filter->register();
+    }
+
+        # Initialize boolean filters (they need the other filters to be
+        # initialized to be able to compile their logic)
+    for my $name (keys %boolean_filters) {
+        my $logic = $data->{filter}->{$name}->{logic}->{value};
+        die "No logic defined for boolean filter $name" unless defined $logic;
+        my $filter = Log::Log4perl::Filter::Boolean->new(
+                         name  => $name, 
+                         logic => $logic);
+        $filter->register();
+    }
+
+    for (@loggers) {
+        my($name, $value) = @$_;
+
+        my $logger = Log::Log4perl::Logger->get_logger($name);
+        my ($level, @appnames) = split /\s*,\s*/, $value;
+
+        $logger->level(
+            Log::Log4perl::Level::to_priority($level),
+            'dont_reset_all');
+
+        if(exists $additivity{$name}) {
+            $logger->additivity($additivity{$name}, 1);
+        }
+
+        for my $appname (@appnames) {
+
+            my $appender = create_appender_instance(
+                $data, $appname, \%appenders_created, \@post_config_subs,
+                $system_wide_threshold);
+
+            $logger->add_appender($appender, 'dont_reset_all');
+            set_appender_by_name($appname, $appender, \%appenders_created);
+        }
+    }
+
+    #run post_config subs
+    for(@post_config_subs) {
+        $_->();
+    }
+
+    #now we're done, set up all the output methods (e.g. ->debug('...'))
+    Log::Log4perl::Logger::reset_all_output_methods();
+
+    #Run a sanity test on the config not disabled
+    if($Log::Log4perl::Config::CONFIG_INTEGRITY_CHECK and
+       !config_is_sane()) {
+        warn "Log::Log4perl configuration looks suspicious: ",
+             "$CONFIG_INTEGRITY_ERROR";
+    }
+
+        # Successful init(), save config for later
+    $OLD_CONFIG = $data;
+
+    $Log::Log4perl::Logger::INITIALIZED = 1;
+}
+
+##################################################
+sub config_is_sane {
+##################################################
+    if(! $LOGGERS_DEFINED) {
+        $CONFIG_INTEGRITY_ERROR = "No loggers defined";
+        return 0;
+    }    
+
+    if(scalar keys %Log::Log4perl::Logger::APPENDER_BY_NAME == 0) {
+        $CONFIG_INTEGRITY_ERROR = "No appenders defined";
+        return 0;
+    }
+
+    return 1;
+}
+
+##################################################
+sub create_appender_instance {
+##################################################
+    my($data, $appname, $appenders_created, $post_config_subs,
+       $system_wide_threshold) = @_;
+
+    my $appenderclass = get_appender_by_name(
+            $data, $appname, $appenders_created);
+
+    print "appenderclass=$appenderclass\n" if _INTERNAL_DEBUG;
+
+    my $appender;
+
+    if (ref $appenderclass) {
+        $appender = $appenderclass;
+    } else {
+        die "ERROR: you didn't tell me how to " .
+            "implement your appender '$appname'"
+                unless $appenderclass;
+
+        if (Log::Log4perl::JavaMap::translate($appenderclass)){
+            # It's Java. Try to map
+            print "Trying to map Java $appname\n" if _INTERNAL_DEBUG;
+            $appender = Log::Log4perl::JavaMap::get($appname, 
+                                        $data->{appender}->{$appname});
+
+        }else{
+            # It's Perl
+            my @params = grep { $_ ne "layout" and
+                                $_ ne "value"
+                              } keys %{$data->{appender}->{$appname}};
+    
+            my %param = ();
+            foreach my $pname (@params){
+                #this could be simple value like 
+                #{appender}{myAppender}{file}{value} => 'log.txt'
+                #or a structure like
+                #{appender}{myAppender}{login} => 
+                #                         { name => {value => 'bob'},
+                #                           pwd  => {value => 'xxx'},
+                #                         }
+                #in the latter case we send a hashref to the appender
+                if (exists $data->{appender}{$appname}
+                                  {$pname}{value}      ) {
+                    $param{$pname} = $data->{appender}{$appname}
+                                            {$pname}{value};
+                }else{
+                    $param{$pname} = {map {$_ => $data->{appender}
+                                                        {$appname}
+                                                        {$pname}
+                                                        {$_}
+                                                        {value}} 
+                                     keys %{$data->{appender}
+                                                   {$appname}
+                                                   {$pname}}
+                                     };
+                }
+    
+            }
+
+            my $depends_on = [];
+    
+            $appender = Log::Log4perl::Appender->new(
+                $appenderclass, 
+                name                 => $appname,
+                l4p_post_config_subs => $post_config_subs,
+                l4p_depends_on       => $depends_on,
+                %param,
+            ); 
+    
+            for my $dependency (@$depends_on) {
+                # If this appender indicates that it needs other appenders
+                # to exist (e.g. because it's a composite appender that
+                # relays messages on to its appender-refs) then we're 
+                # creating their instances here. Reason for this is that 
+                # these appenders are not attached to any logger and are
+                # therefore missed by the config parser which goes through
+                # the defined loggers and just creates *their* attached
+                # appenders.
+                $appender->composite(1);
+                next if exists $appenders_created->{$appname};
+                my $app = create_appender_instance($data, $dependency, 
+                             $appenders_created,
+                             $post_config_subs);
+                # If the appender appended a subroutine to $post_config_subs
+                # (a reference to an array of subroutines)
+                # here, the configuration parser will later execute this
+                # method. This is used by a composite appender which needs
+                # to make sure all of its appender-refs are available when
+                # all configuration settings are done.
+
+                # Smuggle this sub-appender into the hash of known appenders 
+                # without attaching it to any logger directly.
+                $
+                Log::Log4perl::Logger::APPENDER_BY_NAME{$dependency} = $app;
+            }
+        }
+    }
+
+    add_layout_by_name($data, $appender, $appname) unless
+        $appender->composite();
+
+       # Check for appender thresholds
+    my $threshold = 
+       $data->{appender}->{$appname}->{Threshold}->{value};
+
+    if(defined $system_wide_threshold and
+       !defined $threshold) {
+        $threshold = $system_wide_threshold;
+    }
+
+    if(defined $threshold) {
+            # Need to split into two lines because of CVS
+        $appender->threshold($
+            Log::Log4perl::Level::PRIORITY{$threshold});
+    }
+
+        # Check for custom filters attached to the appender
+    my $filtername = 
+       $data->{appender}->{$appname}->{Filter}->{value};
+    if(defined $filtername) {
+            # Need to split into two lines because of CVS
+        my $filter = Log::Log4perl::Filter::by_name($filtername);
+        die "Filter $filtername doesn't exist" unless defined $filter;
+        $appender->filter($filter);
+    }
+
+    if(defined $system_wide_threshold and
+       defined $threshold and
+       $
+        Log::Log4perl::Level::PRIORITY{$system_wide_threshold} > 
+       $
+         Log::Log4perl::Level::PRIORITY{$threshold}
+      ) {
+        $appender->threshold($
+            Log::Log4perl::Level::PRIORITY{$system_wide_threshold});
+    }
+
+    if(exists $data->{appender}->{$appname}->{threshold}) {
+        die "invalid keyword 'threshold' - perhaps you meant 'Threshold'?";
+    }
+
+    return $appender;
+}
+
+###########################################
+sub add_layout_by_name {
+###########################################
+    my($data, $appender, $appender_name) = @_;
+
+    my $layout_class = $data->{appender}->{$appender_name}->{layout}->{value};
+
+    die "Layout not specified for appender $appender_name" unless $layout_class;
+
+    $layout_class =~ s/org.apache.log4j./Log::Log4perl::Layout::/;
+
+        # Check if we have this layout class
+    if(!Log::Log4perl::Util::module_available($layout_class)) {
+        if(Log::Log4perl::Util::module_available(
+           "Log::Log4perl::Layout::$layout_class")) {
+            # Someone used the layout shortcut, use the fully qualified
+            # module name instead.
+            $layout_class = "Log::Log4perl::Layout::$layout_class";
+        } else {
+            die "ERROR: trying to set layout for $appender_name to " .
+                "'$layout_class' failed";
+        }
+    }
+
+    eval "require $layout_class" or 
+        die "Require to $layout_class failed ($!)";
+
+    $appender->layout($layout_class->new(
+        $data->{appender}->{$appender_name}->{layout},
+        ));
+}
+
+###########################################
+sub get_appender_by_name {
+###########################################
+    my($data, $name, $appenders_created) = @_;
+
+    if (exists $appenders_created->{$name}) {
+        return $appenders_created->{$name};
+    } else {
+        return $data->{appender}->{$name}->{value};
+    }
+}
+
+###########################################
+sub set_appender_by_name {
+###########################################
+# keep track of appenders we've already created
+###########################################
+    my($appname, $appender, $appenders_created) = @_;
+
+    $appenders_created->{$appname} ||= $appender;
+}
+
+##################################################
+sub add_global_cspec {
+##################################################
+# the config file said
+# log4j.PatternLayout.cspec.Z=sub {return $$*2}
+##################################################
+    my ($letter, $perlcode) = @_;
+
+    die "error: only single letters allowed in log4j.PatternLayout.cspec.$letter"
+        unless ($letter =~ /^[a-zA-Z]$/);
+
+    Log::Log4perl::Layout::PatternLayout::add_global_cspec($letter, $perlcode);
+}
+
+my $LWP_USER_AGENT;
+sub set_LWP_UserAgent
+{
+    $LWP_USER_AGENT = shift;
+}
+
+
+###########################################
+sub config_read {
+###########################################
+# Read the lib4j configuration and store the
+# values into a nested hash structure.
+###########################################
+    my($config) = @_;
+
+    die "Configuration not defined" unless defined $config;
+
+    my @text;
+    my $parser;
+
+    $CONFIG_FILE_READS++;  # Count for statistical purposes
+
+    my $base_configurator = Log::Log4perl::Config::BaseConfigurator->new(
+        utf8 => $UTF8,
+    );
+
+    my $data = {};
+
+    if (ref($config) eq 'HASH') {   # convert the hashref into a list 
+                                    # of name/value pairs
+        print "Reading config from hash\n" if _INTERNAL_DEBUG;
+        @text = ();
+        for my $key ( keys %$config ) {
+            if( ref( $config->{$key} ) eq "CODE" ) {
+                $config->{$key} = $config->{$key}->();
+            }
+            push @text, $key . '=' . $config->{$key} . "\n";
+        }
+    } elsif (ref $config eq 'SCALAR') {
+        print "Reading config from scalar\n" if _INTERNAL_DEBUG;
+        @text = split(/\n/,$$config);
+
+    } elsif (ref $config eq 'GLOB' or 
+             ref $config eq 'IO::File') {
+            # If we have a file handle, just call the reader
+        print "Reading config from file handle\n" if _INTERNAL_DEBUG;
+        @text = @{ $base_configurator->file_h_read( $config ) };
+
+    } elsif (ref $config) {
+            # Caller provided a config parser object, which already
+            # knows which file (or DB or whatever) to parse.
+        print "Reading config from parser object\n" if _INTERNAL_DEBUG;
+        $data = $config->parse();
+        return $data;
+
+    } elsif ($config =~ m|^ldap://|){
+       if(! Log::Log4perl::Util::module_available("Net::LDAP")) {
+           die "Log4perl: missing Net::LDAP needed to parse LDAP urls\n$@\n";
+       }
+
+       require Net::LDAP;
+       require Log::Log4perl::Config::LDAPConfigurator;
+
+       return Log::Log4perl::Config::LDAPConfigurator->new->parse($config);
+
+    } else {
+
+        if ($config =~ /^(https?|ftp|wais|gopher|file):/){
+            my ($result, $ua);
+    
+            die "LWP::UserAgent not available" unless
+                Log::Log4perl::Util::module_available("LWP::UserAgent");
+
+            require LWP::UserAgent;
+            unless (defined $LWP_USER_AGENT) {
+                $LWP_USER_AGENT = LWP::UserAgent->new;
+    
+                # Load proxy settings from environment variables, i.e.:
+                # http_proxy, ftp_proxy, no_proxy etc (see LWP::UserAgent)
+                # You need these to go thru firewalls.
+                $LWP_USER_AGENT->env_proxy;
+            }
+            $ua = $LWP_USER_AGENT;
+
+            my $req = new HTTP::Request GET => $config;
+            my $res = $ua->request($req);
+
+            if ($res->is_success) {
+                @text = split(/\n/, $res->content);
+            } else {
+                die "Log4perl couln't get $config, ".
+                     $res->message." ";
+            }
+        } else {
+            print "Reading config from file '$config'\n" if _INTERNAL_DEBUG;
+            print "Reading ", -s $config, " bytes.\n" if _INTERNAL_DEBUG;
+              # Use the BaseConfigurator's file reader to avoid duplicating
+              # utf8 handling here.
+            $base_configurator->file( $config );
+            @text = @{ $base_configurator->text() };
+        }
+    }
+    
+    print "Reading $config: [@text]\n" if _INTERNAL_DEBUG;
+
+    if(! grep /\S/, @text) {
+        return $data;
+    }
+
+    if ($text[0] =~ /^<\?xml /) {
+
+        die "XML::DOM not available" unless
+                Log::Log4perl::Util::module_available("XML::DOM");
+
+        require XML::DOM; 
+        require Log::Log4perl::Config::DOMConfigurator;
+
+        XML::DOM->VERSION($Log::Log4perl::DOM_VERSION_REQUIRED);
+        $parser = Log::Log4perl::Config::DOMConfigurator->new();
+        $data = $parser->parse(\@text);
+    } else {
+        $parser = Log::Log4perl::Config::PropertyConfigurator->new();
+        $data = $parser->parse(\@text);
+    }
+
+    $data = $parser->parse_post_process( $data, leaf_paths($data) );
+
+    return $data;
+}
+
+###########################################
+sub unlog4j {
+###########################################
+    my ($string) = @_;
+
+    $string =~ s#^org\.apache\.##;
+    $string =~ s#^log4j\.##;
+    $string =~ s#^l4p\.##;
+    $string =~ s#^log4perl\.##i;
+
+    $string =~ s#\.#::#g;
+
+    return $string;
+}
+
+############################################################
+sub leaf_paths {
+############################################################
+# Takes a reference to a hash of hashes structure of 
+# arbitrary depth, walks the tree and returns a reference
+# to an array of all possible leaf paths (each path is an 
+# array again).
+# Example: { a => { b => { c => d }, e => f } } would generate
+#          [ [a, b, c, d], [a, e, f] ]
+############################################################
+    my ($root) = @_;
+
+    my @stack  = ();
+    my @result = ();
+
+    push @stack, [$root, []];  
+    
+    while(@stack) {
+        my $item = pop @stack;
+
+        my($node, $path) = @$item;
+
+        if(ref($node) eq "HASH") { 
+            for(keys %$node) {
+                push @stack, [$node->{$_}, [@$path, $_]];
+            }
+        } else {
+            push @result, [@$path, $node];
+        }
+    }
+    return \@result;
+}
+
+###########################################
+sub leaf_path_to_hash {
+###########################################
+    my($leaf_path, $data) = @_;
+
+    my $ref = \$data;
+
+    for my $part ( @$leaf_path[0..$#$leaf_path-1] ) {
+        $ref = \$$ref->{ $part };
+    }
+
+    return $ref;
+}
+
+###########################################
+sub eval_if_perl {
+###########################################
+    my($value) = @_;
+
+    if(my $cref = compile_if_perl($value)) {
+        return $cref->();
+    }
+
+    return $value;
+}
+
+###########################################
+sub compile_if_perl {
+###########################################
+    my($value) = @_;
+
+    if($value =~ /^\s*sub\s*{/ ) {
+        my $mask;
+        unless( Log::Log4perl::Config->allow_code() ) {
+            die "\$Log::Log4perl::Config->allow_code() setting " .
+                "prohibits Perl code in config file";
+        }
+        if( defined( $mask = Log::Log4perl::Config->allowed_code_ops() ) ) {
+            return compile_in_safe_cpt($value, $mask );
+        }
+        elsif( $mask = Log::Log4perl::Config->allowed_code_ops_convenience_map(
+                             Log::Log4perl::Config->allow_code()
+                          ) ) {
+            return compile_in_safe_cpt($value, $mask );
+        }
+        elsif( Log::Log4perl::Config->allow_code() == 1 ) {
+
+            # eval without restriction
+            my $cref = eval "package main; $value" or 
+                die "Can't evaluate '$value' ($@)";
+            return $cref;
+        }
+        else {
+            die "Invalid value for \$Log::Log4perl::Config->allow_code(): '".
+                Log::Log4perl::Config->allow_code() . "'";
+        }
+    }
+
+    return undef;
+}
+
+###########################################
+sub compile_in_safe_cpt {
+###########################################
+    my($value, $allowed_ops) = @_;
+
+    # set up a Safe compartment
+    require Safe;
+    my $safe = Safe->new();
+    $safe->permit_only( @{ $allowed_ops } );
+ 
+    # share things with the compartment
+    for( keys %{ Log::Log4perl::Config->vars_shared_with_safe_compartment() } ) {
+        my $toshare = Log::Log4perl::Config->vars_shared_with_safe_compartment($_);
+        $safe->share_from( $_, $toshare )
+            or die "Can't share @{ $toshare } with Safe compartment";
+    }
+    
+    # evaluate with restrictions
+    my $cref = $safe->reval("package main; $value") or
+        die "Can't evaluate '$value' in Safe compartment ($@)";
+    return $cref;
+    
+}
+
+###########################################
+sub boolean_to_perlish {
+###########################################
+    my($value) = @_;
+
+        # Translate boolean to perlish
+    $value = 1 if $value =~ /^true$/i;
+    $value = 0 if $value =~ /^false$/i;
+
+    return $value;
+}
+
+###########################################
+sub vars_shared_with_safe_compartment {
+###########################################
+    my($class, @args) = @_;
+
+        # Allow both for ...::Config::foo() and ...::Config->foo()
+    if(defined $class and $class ne __PACKAGE__) {
+        unshift @args, $class;
+    }
+   
+    # handle different invocation styles
+    if(@args == 1 && ref $args[0] eq 'HASH' ) {
+        # replace entire hash of vars
+        %Log::Log4perl::VARS_SHARED_WITH_SAFE_COMPARTMENT = %{$args[0]};
+    }
+    elsif( @args == 1 ) {
+        # return vars for given package
+        return $Log::Log4perl::VARS_SHARED_WITH_SAFE_COMPARTMENT{
+               $args[0]};
+    }
+    elsif( @args == 2 ) {
+        # add/replace package/var pair
+        $Log::Log4perl::VARS_SHARED_WITH_SAFE_COMPARTMENT{
+           $args[0]} = $args[1];
+    }
+
+    return wantarray ? %Log::Log4perl::VARS_SHARED_WITH_SAFE_COMPARTMENT
+                     : \%Log::Log4perl::VARS_SHARED_WITH_SAFE_COMPARTMENT;
+    
+}
+
+###########################################
+sub allowed_code_ops {
+###########################################
+    my($class, @args) = @_;
+
+        # Allow both for ...::Config::foo() and ...::Config->foo()
+    if(defined $class and $class ne __PACKAGE__) {
+        unshift @args, $class;
+    }
+   
+    if(@args) {
+        @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE = @args;
+    }
+    else {
+        # give back 'undef' instead of an empty arrayref
+        unless( @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE ) {
+            return;
+        }
+    }
+
+    return wantarray ? @Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE
+                     : \@Log::Log4perl::ALLOWED_CODE_OPS_IN_CONFIG_FILE;
+}
+
+###########################################
+sub allowed_code_ops_convenience_map {
+###########################################
+    my($class, @args) = @_;
+
+        # Allow both for ...::Config::foo() and ...::Config->foo()
+    if(defined $class and $class ne __PACKAGE__) {
+        unshift @args, $class;
+    }
+
+    # handle different invocation styles
+    if( @args == 1 && ref $args[0] eq 'HASH' ) {
+        # replace entire map
+        %Log::Log4perl::ALLOWED_CODE_OPS = %{$args[0]};
+    }
+    elsif( @args == 1 ) {
+        # return single opcode mask
+        return $Log::Log4perl::ALLOWED_CODE_OPS{
+                   $args[0]};
+    }
+    elsif( @args == 2 ) {
+        # make sure the mask is an array ref
+        if( ref $args[1] ne 'ARRAY' ) {
+            die "invalid mask (not an array ref) for convenience name '$args[0]'";
+        }
+        # add name/mask pair
+        $Log::Log4perl::ALLOWED_CODE_OPS{
+            $args[0]} = $args[1];
+    }
+
+    return wantarray ? %Log::Log4perl::ALLOWED_CODE_OPS
+                     : \%Log::Log4perl::ALLOWED_CODE_OPS
+}
+
+###########################################
+sub allow_code {
+###########################################
+    my($class, @args) = @_;
+
+        # Allow both for ...::Config::foo() and ...::Config->foo()
+    if(defined $class and $class ne __PACKAGE__) {
+        unshift @args, $class;
+    }
+   
+    if(@args) {
+        $Log::Log4perl::ALLOW_CODE_IN_CONFIG_FILE = 
+            $args[0];
+    }
+
+    return $Log::Log4perl::ALLOW_CODE_IN_CONFIG_FILE;
+}
+
+################################################
+sub var_subst {
+################################################
+    my($varname, $subst_hash) = @_;
+
+        # Throw out blanks
+    $varname =~ s/\s+//g;
+
+    if(exists $subst_hash->{$varname}) {
+        print "Replacing variable: '$varname' => '$subst_hash->{$varname}'\n" 
+            if _INTERNAL_DEBUG;
+        return $subst_hash->{$varname};
+
+    } elsif(exists $ENV{$varname}) {
+        print "Replacing ENV variable: '$varname' => '$ENV{$varname}'\n" 
+            if _INTERNAL_DEBUG;
+        return $ENV{$varname};
+
+    }
+
+    die "Undefined Variable '$varname'";
+}
+
+1;
+
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+Log::Log4perl::Config - Log4perl configuration file syntax
+
+=head1 DESCRIPTION
+
+In C<Log::Log4perl>, configuration files are used to describe how the
+system's loggers ought to behave. 
+
+The format is the same as the one as used for C<log4j>, just with
+a few perl-specific extensions, like enabling the C<Bar::Twix>
+syntax instead of insisting on the Java-specific C<Bar.Twix>.
+
+Comment lines and blank lines (all whitespace or empty) are ignored.
+
+Comment lines may start with arbitrary whitespace followed by one of:
+
+=over 4
+
+=item # - Common comment delimiter
+
+=item ! - Java .properties file comment delimiter accepted by log4j
+
+=item ; - Common .ini file comment delimiter
+
+=back
+
+Comments at the end of a line are not supported. So if you write
+
+    log4perl.appender.A1.filename=error.log #in current dir
+
+you will find your messages in a file called C<error.log #in current dir>.
+
+Also, blanks between syntactical entities are ignored, it doesn't 
+matter if you write
+
+    log4perl.logger.Bar.Twix=WARN,Screen
+
+or 
+
+    log4perl.logger.Bar.Twix = WARN, Screen
+
+C<Log::Log4perl> will strip the blanks while parsing your input.
+
+Assignments need to be on a single line. However, you can break the
+line if you want to by using a continuation character at the end of the
+line. Instead of writing
+
+    log4perl.appender.A1.layout=Log::Log4perl::Layout::SimpleLayout
+
+you can break the line at any point by putting a backslash at the very (!)
+end of the line to be continued:
+
+    log4perl.appender.A1.layout=\
+        Log::Log4perl::Layout::SimpleLayout
+
+Watch out for trailing blanks after the backslash, which would prevent
+the line from being properly concatenated.
+
+=head2 Loggers
+
+Loggers are addressed by category:
+
+    log4perl.logger.Bar.Twix      = WARN, Screen
+
+This sets all loggers under the C<Bar::Twix> hierarchy on priority
+C<WARN> and attaches a later-to-be-defined C<Screen> appender to them.
+Settings for the root appender (which doesn't have a name) can be
+accomplished by simply omitting the name:
+
+    log4perl.logger = FATAL, Database, Mailer 
+
+This sets the root appender's level to C<FATAL> and also attaches the 
+later-to-be-defined appenders C<Database> and C<Mailer> to it.
+
+The additivity flag of a logger is set or cleared via the 
+C<additivity> keyword:
+
+    log4perl.additivity.Bar.Twix = 0|1
+
+(Note the reversed order of keyword and logger name, resulting
+from the dilemma that a logger name could end in C<.additivity>
+according to the log4j documentation).
+
+=head2 Appenders and Layouts
+
+Appender names used in Log4perl configuration file
+lines need to be resolved later on, in order to
+define the appender's properties and its layout. To specify properties
+of an appender, just use the C<appender> keyword after the
+C<log4perl> intro and the appender's name:
+
+        # The Bar::Twix logger and its appender
+    log4perl.logger.Bar.Twix = DEBUG, A1
+    log4perl.appender.A1=Log::Log4perl::Appender::File
+    log4perl.appender.A1.filename=test.log
+    log4perl.appender.A1.mode=append
+    log4perl.appender.A1.layout=Log::Log4perl::Layout::SimpleLayout
+
+This sets a priority of C<DEBUG> for loggers in the C<Bar::Twix>
+hierarchy and assigns the C<A1> appender to it, which is later on
+resolved to be an appender of type C<Log::Log4perl::Appender::File>, simply
+appending to a log file. According to the C<Log::Log4perl::Appender::File>
+manpage, the C<filename> parameter specifies the name of the log file
+and the C<mode> parameter can be set to C<append> or C<write> (the
+former will append to the logfile if one with the specified name
+already exists while the latter would clobber and overwrite it).
+
+The order of the entries in the configuration file is not important,
+C<Log::Log4perl> will read in the entire file first and try to make
+sense of the lines after it knows the entire context.
+
+You can very well define all loggers first and then their appenders
+(you could even define your appenders first and then your loggers,
+but let's not go there):
+
+    log4perl.logger.Bar.Twix = DEBUG, A1
+    log4perl.logger.Bar.Snickers = FATAL, A2
+
+    log4perl.appender.A1=Log::Log4perl::Appender::File
+    log4perl.appender.A1.filename=test.log
+    log4perl.appender.A1.mode=append
+    log4perl.appender.A1.layout=Log::Log4perl::Layout::SimpleLayout
+
+    log4perl.appender.A2=Log::Log4perl::Appender::Screen
+    log4perl.appender.A2.stderr=0
+    log4perl.appender.A2.layout=Log::Log4perl::Layout::PatternLayout
+    log4perl.appender.A2.layout.ConversionPattern = %d %m %n
+
+Note that you have to specify the full path to the layout class
+and that C<ConversionPattern> is the keyword to specify the printf-style
+formatting instructions.
+
+=head1 Configuration File Cookbook
+
+Here's some examples of often-used Log4perl configuration files:
+
+=head2 Append to STDERR
+
+    log4perl.category.Bar.Twix      = WARN, Screen
+    log4perl.appender.Screen        = Log::Log4perl::Appender::Screen
+    log4perl.appender.Screen.layout = \
+        Log::Log4perl::Layout::PatternLayout
+    log4perl.appender.Screen.layout.ConversionPattern = %d %m %n
+
+=head2 Append to STDOUT
+
+    log4perl.category.Bar.Twix      = WARN, Screen
+    log4perl.appender.Screen        = Log::Log4perl::Appender::Screen
+    log4perl.appender.Screen.stderr = 0
+    log4perl.appender.Screen.layout = \
+        Log::Log4perl::Layout::PatternLayout
+    log4perl.appender.Screen.layout.ConversionPattern = %d %m %n
+
+=head2 Append to a log file
+
+    log4perl.logger.Bar.Twix = DEBUG, A1
+    log4perl.appender.A1=Log::Log4perl::Appender::File
+    log4perl.appender.A1.filename=test.log
+    log4perl.appender.A1.mode=append
+    log4perl.appender.A1.layout = \
+        Log::Log4perl::Layout::PatternLayout
+    log4perl.appender.A1.layout.ConversionPattern = %d %m %n
+
+Note that you could even leave out 
+
+    log4perl.appender.A1.mode=append
+
+and still have the logger append to the logfile by default, although
+the C<Log::Log4perl::Appender::File> module does exactly the opposite.
+This is due to some nasty trickery C<Log::Log4perl> performs behind 
+the scenes to make sure that beginner's CGI applications don't clobber 
+the log file every time they're called.
+
+=head2 Write a log file from scratch
+
+If you loathe the Log::Log4perl's append-by-default strategy, you can
+certainly override it:
+
+    log4perl.logger.Bar.Twix = DEBUG, A1
+    log4perl.appender.A1=Log::Log4perl::Appender::File
+    log4perl.appender.A1.filename=test.log
+    log4perl.appender.A1.mode=write
+    log4perl.appender.A1.layout=Log::Log4perl::Layout::SimpleLayout
+
+C<write> is the C<mode> that has C<Log::Log4perl::Appender::File>
+explicitly clobber the log file if it exists.
+
+=head2 Configuration files encoded in utf-8
+
+If your configuration file is encoded in utf-8 (which matters if you 
+e.g. specify utf8-encoded appender filenames in it), then you need to 
+tell Log4perl before running init():
+
+    use Log::Log4perl::Config;
+    Log::Log4perl::Config->utf( 1 );
+
+    Log::Log4perl->init( ... );
+
+This makes sure Log4perl interprets utf8-encoded config files correctly.
+This setting might become the default at some point.
+
+=head1 SEE ALSO
+
+Log::Log4perl::Config::PropertyConfigurator
+
+Log::Log4perl::Config::DOMConfigurator
+
+Log::Log4perl::Config::LDAPConfigurator (coming soon!)
+
+=head1 LICENSE
+
+Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
+and Kevin Goess E<lt>cpan@goess.orgE<gt>.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+
+=head1 AUTHOR
+
+Please contribute patches to the project on Github:
+
+    http://github.com/mschilli/log4perl
+
+Send bug reports or requests for enhancements to the authors via our
+
+MAILING LIST (questions, bug reports, suggestions/patches): 
+log4perl-devel@lists.sourceforge.net
+
+Authors (please contact them via the list above, not directly):
+Mike Schilli <m@perlmeister.com>,
+Kevin Goess <cpan@goess.org>
+
+Contributors (in alphabetical order):
+Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
+Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
+Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
+Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
+Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
+Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
+Lars Thegler, David Viner, Mac Yang.
+