How can I change a log4perl appender's filters at run time? - perl

I'v been trying to figure out if I can change an appender's filter at run-time that I've defined via a configuration file.
log4perl.filter.M1 = Log::Log4perl::Filter::LevelMatch
log4perl.filter.M2 = Log::Log4perl::Filter::LevelMatch
log4perl.filter.M1.LevelToMatch = INFO
log4perl.filter.M1.AcceptOnMatch = true
log4perl.filter.M2.LevelToMatch = WARN
log4perl.filter.M2.AcceptOnMatch = true
log4perl.filter.MyBoolean0 = Log::Log4perl::Filter::Boolean
log4perl.filter.MyBoolean0.logic = M1
log4perl.filter.MyBoolean1 = Log::Log4perl::Filter::Boolean
log4perl.filter.MyBoolean1.logic = M1 || M2
log4perl.appender.SCREEN.Filter = MyBoolean0
I'd like to change this filter from MyBoolean0 for the SCREEN to MyBoolean1, but do it after my program has started running.
Poking at the APPENDER_BY_NAME hash for SCREEN using Data::Dumper shows the following:
$VAR1 = bless( {
'appender' => bless( {
'Filter' => 'MyBoolean0',
'color' => {
...
...
'filter' => bless( {·
'params' => {·
'M3' => bless( {·
'LevelToMatch' => 'ERROR',
'name' => 'M3',
'AcceptOnMatch' => 1
}, 'Log::Log4perl::Filter::LevelMatch' ),
'M1' => bless( {·
'LevelToMatch' => 'INFO',
'name' => 'M1',
'AcceptOnMatch' => 1
}, 'Log::Log4perl::Filter::LevelMatch' ),
'M2' => bless( {·
'LevelToMatch' => 'WARN',
'name' => 'M2',
'AcceptOnMatch' => 1
}, 'Log::Log4perl::Filter::LevelMatch' )
},
'name' => 'MyBoolean0',
'eval_func' => sub { "DUMMY" },
'logic' => 'M1 || M2 || M3'
}, 'Log::Log4perl::Filter::Boolean' ),
'warp_message' => undef,
'name' => 'SCREEN'
}, 'Log::Log4perl::Appender' );
But mucking with this HASH seems hackish to me. Is there a better way to change an appender's filters?

You may use undocumented appender's property filter:
$Log::Log4perl::Logger::APPENDER_BY_NAME{'SCREEN'}->filter(
Log::Log4perl::Filter::by_name('MyBoolean1')
);
Also you may use two appenders:
log4perl.appender.SCREEN0.Filter = MyBoolean0
log4perl.appender.SCREEN1.Filter = MyBoolean1
And change it in runtime:
$logger->remove_appender('SCREEN0', 1);
$logger->add_appender(
Log::Log4perl::Config::create_appender_instance(
$Log::Log4perl::Config::OLD_CONFIG,
'SCREEN1',
\%Log::Log4perl::Logger::APPENDER_BY_NAME
)
);

Related

Accessing a nested data structure

I have an array of hashes nested to multiple levels. I need to extract a value from all deeply-nested hashes that have a given value for a different key in the same hash
This is a collection of entities from our database, and the data represents contacts within each entity and all of their contact values.
There is a hash key contact_method_type_id which refers to an integer defining the type of contact method. The contact_method_type_id that I care about is 1, which is email.
The first contact has three different contact_methods. The first is 4 which is an office phone, the second is a 2 which is a home phone, and the third is a 1 which is email.
Within the same hash is there is a 'contact_method_value', which is the string representation of their email address.
I need a way to extract just these values into a new array
Here are the contents of the first element of the array
$VAR1 = [
{ 'total' => '2',
'results' => [
{ 'contact_type_name' => 'Primary Technical Contact',
'street' => undef,
'state_id' => undef,
'state_name' => undef,
'last_name' => 'Barb',
'entities' => [
{ 'entity_name' => 'XXXXX',
'entity_id' => 'XXXXX'
}
],
'state_abbr_name' => undef,
'city' => undef,
'country_id' => undef,
'latitude' => undef,
'contact_id' => 'XXXXXX',
'contact_type_id' => '1',
'roles' => [],
'contact_methods' => [
{ 'entity_name' => undef,
'contact_method_value' => 'XXXXXXX',
'contact_method_type_id' => '4',
'contact_method_id' => '24041',
'entity_id' => undef,
'contact_method_type_name' => 'Cell Phone'
},
{ 'entity_name' => undef,
'contact_method_value' => 'XXXXXX',
'contact_method_type_id' => '2',
'contact_method_id' => '24051',
'entity_id' => undef,
'contact_method_type_name' => 'Office Phone'
},
{ 'entity_name' => undef,
'contact_method_value' => 'example#example.com',
'contact_method_type_id' => '1',
'contact_method_id' => '24061',
'entity_id' => undef,
'contact_method_type_name' => 'Email'
}
],
'country_name' => undef,
'longitude' => undef,
'country_abbr_name' => undef,
'full_name' => 'NAME',
'networks' => [
{ 'network_name' => 'NET',
'network_id' => 'X'
}
],
'timezone_id' => undef,
'zip' => undef,
'timezone_name' => undef,
'title' => 'MAC/Network Specialist',
'first_name' => 'Terri'
},
{ 'contact_type_name' => 'Primary Technical Contact',
'street' => 'STREET',
'state_id' => undef,
'state_name' => undef,
'last_name' => 'NAME',
'entities' => [
{ 'entity_name' => 'NAME',
'entity_id' => '2679'
}
],
'state_abbr_name' => undef,
'city' => 'CITY',
'country_id' => undef,
'latitude' => undef,
'contact_id' => '7896',
'contact_type_id' => '1',
'roles' => [],
'contact_methods' => [
{ 'entity_name' => undef,
'contact_method_value' => 'example#example.com',
'contact_method_type_id' => '1',
'contact_method_id' => '16796',
'entity_id' => undef,
'contact_method_type_name' => 'Email'
},
{ 'entity_name' => undef,
'contact_method_value' => 'number',
'contact_method_type_id' => '2',
'contact_method_id' => '16797',
'entity_id' => undef,
'contact_method_type_name' => 'Office Phone'
}
],
'country_name' => undef,
'longitude' => undef,
'country_abbr_name' => undef,
'full_name' => 'NAME',
'networks' => [
{ 'network_name' => 'net',
'network_id' => '17'
}
],
'timezone_id' => undef,
'zip' => 'zip',
'timezone_name' => undef,
'title' => 'Infrastructure Manager',
'first_name' => 'name'
}
],
'offset' => '0'
},
...
This looks suspiciously like something that XML::Simple would have generated.
Assuming this is the case, then I would suggest that you've fallen for the classic mistake of assuming XML::Simple actually helps.
Under that assumption, if you instead use XML::Twig:
Taking your $VAR1. Although - ideally you'll just parse the original source with parse or parsefile:
use XML::Twig;
use XML::Simple;
my $twig = XML::Twig->parse( XMLout($VAR1) );
print $_->att('contact_method_value'), "\n" for $twig->findnodes('//contact_methods[#contact_method_type_name="Email"]');
Which given your sample (as $VAR1):
example#example.com
example#example.com
Edit: Because you've commented that it's JSON then I wouldn't necessarily do this (Although - it does actually work, despite that).
If the data structures are all of the same kind, this is very trivial. You just need to iterate all the outer hashrefs (I called those resultsets). Inside those, you need to look at all results, and in each result you need to look at all the contact methods. If one of them has a contact_method_type_id of 1, you take the contact_method_value. And that's it.
my #email_addresses;
foreach my $resultset ( #{$data} ) {
foreach my $result ( #{ $resultset->{results} } ) {
foreach my $contact ( #{ $result->{contact_methods} } ) {
push #email_addresses , [ $contact->{contact_method_value} ]
if $contact->{contact_method_type_id} == 1;
}
}
}
This code assumes your structure is called $data. #email_addresses looks like this when output.
[
[ 'EMAIL' ],
[ 'EMAIL' ]
];
If you have this on a database then you should use an SQL query to retrieve it, rather than fetching everything into memory and processing what you have
The output from Data::Dumper shows the contents of your data, but it doesn't explain what you're dealing with in your code. Specifically, you don't have a $VAR1 in your code, but I have no idea what you do have
In the end, I think I wouldn't start from here. But since it's the only starting point I have to work with, it's a simple matter of recursing through the data structure
I've assumed that you want
$VAR1->[*]{results}[*]{contact_methods}[*]{contact_method_value}
where
$VAR1->[*]{results}[*]{contact_methods}[*]{contact_method_type_name} eq 'Email'
Update
Since your comments I've altered my code to select the same values where
$VAR1->[*]{results}[*]{contact_methods}[*]{contact_method_type_id} == 1
Since you said nothing about your code at all, I've had to assume a variable $data which contains a reference to the array that you show in your question
for my $item ( #$data ) {
my $results = $item->{results};
for my $result ( #$results ) {
my $methods = $result->{contact_methods} or die;
for my $method ( #$methods ) {
#my $type_name = $method->{contact_method_type_name};
#next unless $type_name eq 'Email';
my $type_id = $method->{contact_method_type_id};
next unless $type_id == 1; ## Email
my $value = $method->{contact_method_value};
print "$value\n";
}
}
}
output
example#example.com
example#example.com

ElasticSearch (search_context_missing_exception) with Search::ElasticSearch::Scroll

I'm using Search::Elasticsearch and Search::Elasticsearch::Scroll for search and scroll into my elasticsearch server.
In scrolling process, for some querys, I'm seeing the next errors while I'm scrolling the search results:
2016/03/22 11:03:38 - 265885 FATAL: [Daemon.pm][8221]: Something gone wrong, error $VAR1 = bless( {
'msg' => '[Missing] ** [http://localhost:9200]-[404] Not Found, called from sub Search::Elasticsearch::Scroll::next at searcher.pl line 92. With vars: {\'body\' => {\'hits\' => {\'hits\' => [],\'max_score\' => \'0\',\'total\' => 5215},\'timed_out\' => bless( do{\\(my $o = 0)}, \'JSON::XS::Boolean\' ),\'_shards\' => {\'failures\' => [{\'index\' => undef,\'reason\' => {\'reason\' => \'No search context found for id [4920053]\',\'type\' => \'search_context_missing_exception\'},\'shard\' => -1},{\'index\' => undef,\'reason\' => {\'reason\' => \'No search context found for id [5051485]\',\'type\' => \'search_context_missing_exception\'},\'shard\' => -1},{\'index\' => undef,\'reason\' => {\'reason\' => \'No search context found for id [4920059]\',\'type\' => \'search_context_missing_exception\'},\'shard\' => -1},{\'index\' => undef,\'reason\' => {\'reason\' => \'No search context found for id [5051496]\',\'type\' => \'search_context_missing_exception\'},\'shard\' => -1},{\'index\' => undef,\'reason\' => {\'reason\' => \'No search context found for id [5051500]\',\'type\' => \'search_context_missing_exception\'},\'shard\' => -1}],\'failed\' => 5,\'successful\' => 0,\'total\' => 5},\'_scroll_id\' => \'c2NhbjswOzE7dG90YWxfaGl0czo1MjE1Ow==\',\'took\' => 2},\'request\' => {\'serialize\' => \'std\',\'path\' => \'/_search/scroll\',\'ignore\' => [],\'mime_type\' => \'application/json\',\'body\' => \'c2Nhbjs1OzQ5MjAwNTM6bHExbENzRDVReEc0OV9UMUgzd3Vkdzs1MDUxNDg1OnJrQ3lsUkRKVHRxRWRWeURoOTB4WVE7NDkyMDA1OTpscTFsQ3NENVF4RzQ5X1QxSDN3dWR3OzUwNTE0OTY6cmtDeWxSREpUdHFFZFZ5RGg5MHhZUTs1MDUxNTAwOnJrQ3lsUkRKVHRxRWRWeURoOTB4WVE7MTt0b3RhbF9oaXRzOjUyMTU7\',\'qs\' => {\'scroll\' => \'1m\'},\'method\' => \'GET\'},\'status_code\' => 404}
',
'stack' => [
[
'searcher.pl',
92,
'Search::Elasticsearch::Scroll::next'
]
],
'text' => '[http://localhost:9200]-[404] Not Found',
'vars' => {
'body' => {
'hits' => {
'hits' => [],
'max_score' => '0',
'total' => 5215
},
'timed_out' => bless( do{\(my $o = 0)}, 'JSON::XS::Boolean' ),
'_shards' => {
'failures' => [
{
'index' => undef,
'reason' => {
'reason' => 'No search context found for id [4920053]',
'type' => 'search_context_missing_exception'
},
'shard' => -1
},
{
'index' => undef,
'reason' => {
'reason' => 'No search context found for id [5051485]',
'type' => 'search_context_missing_exception'
},
'shard' => -1
},
{
'index' => undef,
'reason' => {
'reason' => 'No search context found for id [4920059]',
'type' => 'search_context_missing_exception'
},
'shard' => -1
},
{
'index' => undef,
'reason' => {
'reason' => 'No search context found for id [5051496]',
'type' => 'search_context_missing_exception'
},
'shard' => -1
},
{
'index' => undef,
'reason' => {
'reason' => 'No search context found for id [5051500]',
'type' => 'search_context_missing_exception'
},
'shard' => -1
}
],
'failed' => 5,
'successful' => 0,
'total' => 5
},
'_scroll_id' => 'c2NhbjswOzE7dG90YWxfaGl0czo1MjE1Ow==',
'took' => 2
},
'request' => {
'serialize' => 'std',
'path' => '/_search/scroll',
'ignore' => [],
'mime_type' => 'application/json',
'body' => 'c2Nhbjs1OzQ5MjAwNTM6bHExbENzRDVReEc0OV9UMUgzd3Vkdzs1MDUxNDg1OnJrQ3lsUkRKVHRxRWRWeURoOTB4WVE7NDkyMDA1OTpscTFsQ3NENVF4RzQ5X1QxSDN3dWR3OzUwNTE0OTY6cmtDeWxSREpUdHFFZFZ5RGg5MHhZUTs1MDUxNTAwOnJrQ3lsUkRKVHRxRWRWeURoOTB4WVE7MTt0b3RhbF9oaXRzOjUyMTU7',
'qs' => {
'scroll' => '1m'
},
'method' => 'GET'
},
'status_code' => 404
},
'type' => 'Missing'
}, 'Search::Elasticsearch::Error::Missing' );
The code I'm using is the next one (simplified) :
# Retrieve scroll
my $scroll = $self->getScrollBySignature($item);
# Retrieve all affected documents ids
while (my #docs = $scroll->next(500)) {
# Do stuff with #docs
}
The function getScrollBySignature have the next code in order to call to elasticSearch
my $scroll = $self->{ELASTIC}->scroll_helper(
index => $self->{INDEXES},
search_type => 'scan',
ignore_unavailable => 1,
body => {
size => $self->{PAGINATION},
query => {
filtered => {
filter => {
bool => {
must => [{term => {signature_id => $item->{profileId}}}, {terms => {channel_type_id => $type}}]
}
}
}
}
}
);
As you can see, I'm doing the scroll without passing scroll parameter then as documentation says, the time that scroll is alive is 1 min.
The elasticSearch is a cluster of 3 servers, and the query that ends with that error retrieves a bit more than 5000 docs.
My first solution was to update the life time for scroll to 5 minutes and the error didn't appear.
The question is, as I understand every time I'm calling $scroll->next() the life time off scroll affected is upgraded 1m more, then how is possible to receive those context related errors?
I'm doing something in a bad manner?
Thank you all.
The first thing that comes to mind is that the timer is not updated. Have you checked this? You can do a query every 10 seconds for example and see if at the 6th query it gives you the error ...
Well, a good rule of thumb is inside a ->next() block, don't stay by iteration more than time that you've configured in scroll.
Between each call of ->next() you cannot stay more than that time configured. If you stay more, the scroll may be not be there and the error earch_context_missing_exception will appear.
My solution for this problem was inside next block only store data into array/hash structure and once the scroll process ended work with all data.
The solution of the question example:
# Retrieve scroll
my $scroll = $self->getScrollBySignature($item);
# Retrieve all affected documents ids
my #allDocs;
while (my #docs = $scroll->next(500)) {
push #allDocs, map {$_->{_id}} #docs
}
foreach (#allDocs) {
# Do stuff with doc
}

Web::Scraper nested structures & elements only containing spesific data

I have the following code to scrape a form for inputs and get the attributes id and name.
#!/usr/bin/perl
use warnings;
use strict;
use URI;
use Data::Dumper::Simple;
use Web::Scraper;
my $urlToScrape = "http://digitalarkivet.arkivverket.no/finn_kilde";
my $scrap = scraper {
process 'div.listGroup.open > ul.grouped > li.expandable', 'data[]' => scraper {
process 'input', 'id' => '#id', name => '#name';
process 'label', 'label_for' => '#for';
process 'span.listExpander ', 'Text' => 'TEXT';
process 'ul.sublist1', 'sublist[]' => scraper {
process 'input', 'id' => '#id', name => '#name';
process 'label', 'label_for' => '#for';
process 'span', 'label' => 'TEXT';
};
};
};
my $res = $scrap->scrape(URI->new($urlToScrape));
print Dumper($res);
which gives me (shortend $res to fit screen better)
$res = {
'data' => [
{
'label_for' => 'ka0',
'sublist' => [
{
'label' => 'Statlig folketelling',
'label_for' => 'ka0kt0',
'name' => 'kt[]',
'id' => 'ka0kt0'
}
],
'name' => 'ka[]',
'id' => 'ka0>',
'Text' => 'Folketellinger'
},
{
'sublist' => [
{
'label' => 'Manntall',
'name' => 'kt[]',
'label_for' => 'ka1kt0',
'id' => 'ka1kt0'
}
],
'label_for' => 'ka1',
'id' => 'ka1>',
'name' => 'ka[]',
'Text' => 'Manntall'
},
....
{
'label_for' => 'r0',
'sublist' => [
{
'label_for' => 'r0f0',
'id' => 'r0f0',
'name' => 'f[]',
'label' => "01 Østfold"
}
],
'id' => 'r0',
'name' => 'r[]',
'Text' => "Østlandet"
},
{
'Text' => "Sørlandet",
'id' => 'r1',
'sublist' => [
{
'label_for' => 'r1f0',
'name' => 'f[]',
'id' => 'r1f0',
'label' => '09 Aust-Agder'
}
],
'label_for' => 'r1',
'name' => 'r[]'
}
]
};
I' have 2 issues I need to fix. First, I only want to get data for inputs having 'name' = ka[] (at top level).
Second, I only get data for first ul.sublist1 (If you study the page I'm scraping you can see that several "Kildekategori" have subsets of data, which are revealed if expanded/ clicked upon. Putting brackets on Text[] only gets me the sublist textnames, but not their attributes.
I'm thinking I might have to grab data in 2 scrapes instead, since nested values are revealed by id and label_for.
Solved it by scraping three times, foreach "level"
#!/usr/bin/perl
use strict;
use warnings;
use URI;
use Web::Scraper;
use Data::Dumper::Simple;
my %site;
my #res;
my $i;
my $j;
my $label_for;
my #scrape;
$site{'siteID'} = 1;
$site{'url'} = "http://digitalarkivet.arkivverket.no/finn_kilde";
$site{'name'} = "finn_kilde";
open FIL, ">$site{'name'}.csv" or die $!;
my $seperator=";";
$scrape[0] = scraper {
process 'div.listGroup.open > ul.grouped > li.expandable', 'data[]' => scraper {
process 'input',
'id' => '#id',
'value' => '#value',
'type' => '#type',
'name' => '#name';
process 'label', 'label_for' => '#for';
process 'span.listExpander ', 'text' => 'TEXT';
};
};
$scrape[1] = scraper {
process 'ul.sublist1 > li', 'data[]' => scraper {
process 'input',
'id' => '#id',
'value' => '#value',
'type' => '#type',
'name' => '#name';
process 'label', 'label_for' => '#for';
process 'span', 'text' => 'TEXT';
}
};
$scrape[2] = scraper {
process 'ul.sublist2 > li', 'data[]' => scraper {
process 'input',
'id' => '#id',
'value' => '#value',
'type' => '#type',
'name' => '#name';
process 'label', 'label_for' => '#for';
process 'span', 'text' => 'TEXT';
}
};
for $i (0 .. $#scrape){
$res[$i] = $scrape[$i]->scrape(URI->new($site{'url'}));
unless ($i) {
print FIL join($seperator,"label_for","text","name","value","id","type")."\n";
}
for $j (0 .. $#{$res[$i]->{data}}) {
if (defined($res[$i]->{data}[$j]->{label_for})){
$label_for=$res[$i]->{data}[$j]->{label_for};
} else {
$label_for="";
}
if (length($label_for)>0) {
my $name=$res[$i]->{data}[$j]->{name};
my $text=$res[$i]->{data}[$j]->{text};
my $value=$res[$i]->{data}[$j]->{value};
my $id=$res[$i]->{data}[$j]->{id};
my $type=$res[$i]->{data}[$j]->{type};
my #row=($label_for,$text,$name,$value,$id,$type);
print FIL join($seperator,#row);
print FIL "\n";
}
}
sleep(2);
}
close FIL;
print Dumper(\#res);
1;

Accessing data within a Perl variable

I dumped out a Perl variable called $prefs and got this:
$VAR1 = bless( {
'USERID' => 1286,
'PREFS' => {
'1' => {
'VALUE' => 1,
'OTHERS_POST' => 1,
'CLIENTS_POST' => 1,
'ASSIGNED_TASKS' => 1
}
},
'dbh' => bless( {
'_sth' => bless( {}, 'DBI::st' ),
'_dbh' => bless( {}, 'DBI::db' )
}, 'Taskman::DB' )
}, 'USystems::UserPrefs' );
I'm pretty new to Perl, and I was wondering if someone can break down on whether or not it is possible to access specific data within this variable.
Like if I wanted to do an if statement such as
if (OTHERS_POST == 1) {
// code }
How would I get to the actual OTHERS_POST inside the $prefs variable
$prefs->{PREFS}->{1}->{OTHERS_POST};

How to access individual elements of perl Hashed object?

I'm a non-programmer attemting to retrieve useful info from our InfoBlox DHCP boxes. I've installed the Perl API and can make some use of it.
I've got an output from the Data::Dumper "thingie" that appears to have some of the info I want. I'd like to directly reference some of that data but I'm unsure how.
print Dumper(\$object)
Here is part of the Data::Dumper output;
$VAR1 = \bless( {
'network' => '10.183.1.0/24',
'override_lease_scavenge_time' => 'false',
'enable_ifmap_publishing' => 'false',
'low_water_mark_reset' => '10',
'use_lease_time' => 0,
'use_enable_option81' => 0,
'network_container' => '/',
'override_ddns_ttl' => 'false',
'rir' => 'NONE',
'network_view' => bless( {
<snip> --------------------------------------
'extattrs' => {
'Use' => bless( {
'value' => 'Voip'
}, 'Infoblox::Grid::Extattr' )
},
<snip> --------------------------------------
'members' => [
bless( {
'ipv4addr' => '10.85.9.242',
'name' => 'ig3-app3.my.net'
}, 'Infoblox::DHCP::Member' ),
bless( {
'ipv4addr' => '10.85.9.210',
'name' => 'ig3-app1.my.net'
}, 'Infoblox::DHCP::Member' ),
bless( {
'ipv4addr' => '10.85.9.226',
'name' => 'ig3-app2.my.net'
}, 'Infoblox::DHCP::Member' )
],
'override_ignore_client_identifier' => 'false',
'email_list' => undef,
'rir_registration_status' => '??
}, 'Infoblox::DHCP::Network' );
How do I view the elements? ie ...
print $object{members->name};
print $object{members->ipv4addr};
print $object{extattrs->Use->value};
I've found the API dox insufficiant for my skill level:) The data I'd like to pull remains just out of reach.
my #retrieved_objs = $session->search (
object => "Infoblox::DHCP::Network",
network => '.*\.*\.*\..*',
);
foreach $object ( #retrieved_objs ) {
my $network = $object->network;
my $comment = $object->comment;
my $extattrs = $object->extattrs;
my $options = $object->options;
print $network, " network ", $comment, " ", $extattrs, " ", $options, "\n";
}
-------- output ---
10.183.2.0/24 network HASH(0x6a2f038) ARRAY(0x1d20eb0)
10.192.1.0/24 network HASH(0x9df6540) ARRAY(0x9df5468)
10.192.2.0/24 network HASH(0xa088fc8) ARRAY(0xa089718)
You shouldn't try to access the internal values of an object directly. The module - in this case Infoblox::DHCP::Network will provide methods that allow you to read or manipulate the values properly.