Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

The Monastery Gates

( #131=superdoc: print w/replies, xml ) Need Help??

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
creating and managing many hashes
6 direct replies — Read more / Contribute
by Gtforce
on Feb 18, 2018 at 02:18

    My data is as follows:

    2018-01-01 apple 200 50000 2018-01-02 apple 201 60000 2018-01-03 apple 202 70000 2018-01-04 apple 198 80000 2018-01-01 orange 400 30000 2018-01-02 orange 401 35000 2018-01-03 orange 402 36000 2018-01-04 orange 405 28000

    where apple and orange are my products, and I have over 2,000 distinct products. The values 201,202, etc are the prices of those products on the respective dates represented in the first column (and the quantities aka inventories are in the last column). My data series is for the past 3 years for each of these products.

    I need to pass the data series (i.e., price and inventory) for one product at a time to a subroutine that calculates the mean,, etc.

    I also need to pass the data series for a combination of two products at a time (a pair) to a subroutine that calculates the correlation between the two data series.

    I have currently done this using arrays over the 2 million pairs that arise from 2,000 products and it ran for 4 days before my patience ran out and I terminated the process. I've only just started reading up on hashes and I think I can speed up things if I get the data series for one product into one hash, and the data series for another product into another hash (likewise for 2,000 products or hashes).

    The reading I've done so far warns me against using variables for hashnames. Any advice you can offer would be greatly appreciated, thanks.

Convert string to variable
4 direct replies — Read more / Contribute
by ShermW0829
on Feb 16, 2018 at 15:27

    Name: Sherman 71 years old retired and creating my own poker visits database

    Platform: HP Compaq 6710b

    Operating System: Ubuntu 17.10

    PERL Version: 5.26

    postgresql Version: 9.6

    Problem: Need to assign a string to act as a variable

    I am building a front end for postgresql entries. I have fourteen entries that I need to query the user and set the user's value into a variable. I am using IO::Prompt.

    If I straight-line the code everything works. e.g:

    my ($date_in, $date_out); $date_in - prompt("Start Date: "); $date_in =~ s/^\s+|\s+$//g; $date_out = prompt("$End Date: "); $date_out =~ s/^\s+|\s+$//g;

    And 12 more user inputs to get along with the no space check equals 24 more lines of code. Lots of code so I tried the following:

    my ($k, $date_in, $date_out); my %var_list = ('date_in'=>'Start Date', 'date_out'=>'End Date'); foreach $k (keys(%var_list)) { ## $k prints date_out and then date_in print( "\$k: \"$k\"\n" ); ## $var_list prints End Date and then Start Date print( "\$var_list{k}: \"$var_list{$k}\"\n" ); ## Below is where I want to go: ## $k = prompt($var_list{k}); ## and have $date_out = user's entry ## ## Now how do I assign a beginning $ ## to change date_out to $date_out? ## The below does not work ## ${$k} = prompt(${$var_list{k}}); ## ## I've tried $$k, $($k), and ${$k} ## An example error is the following: ## Can't use string ("date_out") as a SCALAR ## ref while "strict refs" in use at ## ./build_sql_entries line 25 }

    Thank you;


Appending downlad file LWP
1 direct reply — Read more / Contribute
by Anonymous Monk
on Feb 16, 2018 at 13:52


    I am trying to improve some code. Basically, I want to build a downloader with progress bar. I know how to download file, how to build a progress bar (for example in Tk). What I cannot solve is appending the portion of file I have downloaded to the main (final) file. Here it is what I got (stripped of the GUI part. The code is based on a solution I found on the web.

    use strict; use warnings; use LWP::Simple; use LWP::UserAgent; my $url=''; my $ttlDown = 0; my $resp = LWP::UserAgent->new()->get($url, ':content_cb' => sub { my ($data, $response) = @_; my $size = $response->content_length; $ttlDown += length $data; printf("%7.1f KB of %7.1f (%5.1f%%)$/", $ttlDown / 1024.0, $size / 1024.0, $ttlDown * 100.0 / $size ); #Here I need to append the bit of file downloaded, but I am down +loaded the entire file over and over... my $file = 'myfile.exe'; getstore($url, $file); });
including variables
6 direct replies — Read more / Contribute
by LloydRice
on Feb 16, 2018 at 11:32

    I have a short bit of Perl variable definitions that I would like to use in two different scripts. The simple plan is that I would not need to maintain 2 copies of that fragment. I have tried do, exec, use, module, a few more things. It all seems designed to defeat my simple goal by imposing all of the module structure. As I read the new Camel book, "do" should do what I want. But the variables do not get into the calling script. What am I missing?

HASH Hierarchy
3 direct replies — Read more / Contribute
by dirtdog
on Feb 16, 2018 at 10:40

    Hi Monks, I've got a working snippet of code that will take parameters and stuff them into a hash to be used later in the program to only keep the highest ranked value only (0 is top ranked) if it exists. POPE PATRIARCH ARCHBISHOP CARDINAL
    #!/usr/bin/env perl use strict; my @hierarchy; my %hierarchy; my $order =0; while ($#ARGV >= 0) { push @hierarchy,shift; } for (@hierarchy) { $hierarchy{$_} = $order; $order++; } while( my( $key, $value ) = each %hierarchy ){ print "$key: $value\n"; }

    The code appears to work, but I thought there might be a better way to do it so thought I'd check with the Monks.

    Much appreciated!

tinyDNS deconstruct.
2 direct replies — Read more / Contribute
by 0xdeadbad
on Feb 15, 2018 at 12:40

    Could somebody lend a hand with deconstructing tinydns CAA records please.

    "\000\" > "CAA IN 0 issue" [flag] [tag] [issuer]

    The first octal is the Flag ( 000 )
    The second octal ( 005 ) is the taglength and used to deduce the tag and issuer from the ascii string.

    If I could just get "\000\" translated to "0,5," that would be a great help. I've been looking at pack and unpack but cannot work it out as I'm not a real programmer.

    many thanks
Use function as a regex
4 direct replies — Read more / Contribute
by stevieb
on Feb 15, 2018 at 11:22

    I've got a very large and complex distribution where several of the modules use a pretty high number of somewhat complex regexes. I have decided instead of having them peppered throughout the code, I'd create a new module, that would house and return these regexes based on name.

    Now, this all works well and fine after some fiddling and learning where certain flags need to be set. Here is a basic example:

    use warnings; use strict; package Re; { my %h = ( re => qr/ [Pp]erl-\d\.\d+\.\d+(?:_\w+)? \s+===.*? (?=(?:[Pp]erl-\d\.\d+\.\d+(?:_\w+)?\s+===|$)) /xs, ); sub re { return $h{re}; } } package main; { my $str; { local $/; $str = <DATA>; } my $re = Re::re(); my @results = $str =~ /$re/g; print scalar @results; } __DATA__ perl-5.26.1 ========== Reading '/home/spek/.cpan/Metadata' Database was generated on Tue, 13 Feb 2018 15:29:02 GMT App::cpanminus is up to date (1.7043). --> Working on . Configuring /home/spek/repos/mock-sub ... OK <== Installed dependencies for .. Finishing. --> Working on . Configuring /home/spek/repos/mock-sub ... Generating a Unix-style Make +file Writing Makefile for Mock::Sub Writing MYMETA.yml and MYMETA.json OK Building and testing Mock-Sub-1.10 ... Skip blib/lib/Mock/ (unch +anged) Skip blib/lib/Mock/Sub/ (unchanged) Manifying 2 pod documents PERL_DL_NONLAZY=1 "/home/spek/perl5/perlbrew/perls/perl-5.26.1/bin/per +l" "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Har +ness::Switches; test_harness(0, 'blib/lib', 'blib/arch')" t/*.t t/00-load.t .................... ok t/01-called.t .................. ok t/02-called_count.t ............ ok t/03-instantiate.t ............. ok t/04-return_value.t ............ ok t/05-side_effect.t ............. ok t/06-reset.t ................... ok t/07-name.t .................... ok t/08-called_with.t ............. ok t/09-void_context.t ............ ok t/10-unmock.t .................. ok t/11-state.t ................... ok t/12-mocked_subs.t ............. ok t/13-mocked_objects.t .......... ok t/14-core_subs.t ............... ok t/15-remock.t .................. ok t/16-non_exist_warn.t .......... ok t/17-no_warnings.t ............. ok t/18-bug_25-retval_override.t .. ok t/19-return_params.t ........... ok t/manifest.t ................... skipped: Author tests not required fo +r installation t/pod-coverage.t ............... skipped: Author tests not required fo +r installation t/pod.t ........................ skipped: Author tests not required fo +r installation All tests successful. Files=23, Tests=243, 2 wallclock secs ( 0.13 usr 0.04 sys + 1.75 cu +sr 0.13 csys = 2.05 CPU) Result: PASS OK Successfully tested Mock-Sub-1.10

    In the code, I've got this:

    my $re = Re::re(); my @results = $str =~ /$re/g;

    What I'm wondering, and haven't been able to sort out if it's possible, is skip the variable instantiation, and use the function call directly when using the regex, like this:

    my @results = $str =~ /Re::re()/g;

    Doable, or am I chasing down something impossible?

user net:openSSH and File::find::Rule together.
1 direct reply — Read more / Contribute
by garcimo
on Feb 15, 2018 at 09:52
    Hello I would like to search files in a remote system that match certain pattern that are older than one hour. the remote system is solaris. the find in solaris does not have parametres like mmtime. so I created this script that does more or less what i want in the remote system.
    #!/usr/bin/perl use File::Find::Rule; use POSIX qw(strftime); my $today = time(); my $onehour = $today - (60*60); my @files = File::Find::Rule->file() ->name("*.0") ->mtime("<$onehour") ->in( "/mypath/" ); for my $file (@files) { print "$file\n"; }
    now I want to use from a remote system using net:openssh so that it connects to the solaris with ssh finds the file and gives me the output..
    use Net::OpenSSH; my $dir = '/mypath'; my $host = 'myhost'; my $ssh = Net::OpenSSH->new($host, user => adm_garcimo); $ssh->error and die "Couldn't establish SSH connection: ". $ssh->error;
    is there a way to merge the two script in one central server without having to scp the scripts to all the hosts that the script needs to find files... I hope imy question is clear
Running a perl script with root, changing to another user and then back to root?
4 direct replies — Read more / Contribute
by morthed
on Feb 15, 2018 at 09:13

    I've tried to search a lot around the web for this question, to no avail. <\p>

    Currently I'm building a perl script that needs to do a specific job for each line in some database. The database contains several arguements including a "user" field. The script runs as root, and in each line iteration in the db, it will need to switch to the user provided and operate as the user, finishing the round and exiting back to root and then again, running as a different user. <\p>

    So far I've tried: <\p>

    using POSIX::setuid($User) in order to switch to the user within the same script, meaning:<\p><code>while (my $line = <$DB>) .. some code .. POSIX::setuid($User); #switch to user ... do stuff POSIX::setuid(0); #return to root <\code>

    But this solution didn't work so well, after changing once it was stuck in this user through all iterations of the loop, and couldn't return to root, which is obviously logical because it doesn't have the correct permissions.<\p>

    Since this didn't work, I thought to myself maybe I should split the job into 2 scripts. One script will run as root, whereas the other script will be called to by root in the first script and then use POSIX::setuid. I thought, that maybe because it's a subproc\shell it'll just return itself back to root once the job is done on the second script, but it doesn't work as well... I'm kinda out of ideas, anything you guys think'll help?<\p>

    ANOTHER THING: I know this is probably incorrect, so that's why I ask this around... please keep mean comments off or stuff like "you don't know what you're doing", if I did I wouldn't have asked... I basically look for a safe way to change the eid\uid of the SECOND SCRIPT only and keep root as the user for the main one... is there a way for that? Thanks! <\p>

Blockchain and Perl
1 direct reply — Read more / Contribute
by baxy77bax
on Feb 15, 2018 at 05:46

    This is just an info question. In light of blockchain "crazies" I was wondering are there any tutorials on how to make your own with Perl or something, anything related. How to make a Dapp maybe? I seen there was a post (here) 2 years ago on the subject but I could not find any recent posts. I, myself am not very familiar with the tech but would love to learn and if possible to learn it through perl, that would be awesome :)

    Thank you !

Strange memory growth
5 direct replies — Read more / Contribute
by spica1001
on Feb 14, 2018 at 13:02

    Hi all. Here's an odd one, to me anyway. I'm running a script to process very large XML files with embedded JSON. When I run it, the memory increases indefinitely (the file can be 100s of GB and the RAM usage reaches 25GB+). Boiling it down, I reach the below. If I remove the line marked "## THIS LINE", the memory remains static, but leave it in and it increases again. Adding in a load of undefs seems to make no difference. It's evidently leaving the hash array around, but I can't see how to 'free' it.

    Why would accessing a non-existent hash value cause that, or of course even better how do I prevent it?! Thanks for any help...

    use JSON; open(IN,"<:utf8","$ARGV[0]"); while(<IN>) { if (m!^\s+<text.*?>({[^\{\|].+})</text>!) { my $jt = $+; $jt=~s/\&quot;/\"/g; my $json = new JSON; my $jp = $json->allow_nonref->utf8->relaxed->decode($jt); my $c = $jp->{'claims'}; # "claims":{"P31":[{"mainsnak":{"snaktype":"value","property": +"P31","hash":"...","datavalue":{"value":{"entity-type":"item","numeri +c-id":5},...}... }...}], if (ref($c) eq 'HASH') { foreach my $ch (keys %$c) { if (ref($c->{$ch}) eq 'ARRAY') { foreach my $cg (@{$c->{$ch}}) { if (defined $cg->{'mainsnak'}->{'datavalue'}-> +{'value'}->{'notexist'}) {} ## THIS LINE } } } } } }
crypt sometimes returning undef
4 direct replies — Read more / Contribute
by Beaker
on Feb 14, 2018 at 04:39

    I've moved to a new server, which has changed my Perl version from v5.10.1 to v5.16.3

    The following code is designed to generate a temporary user login password.

    srand(time ^ $$); my @passset = ('a'..'k', 'm'..'n', 'p'..'z', '2'..'9'); my $passwrd1 = ""; for (my $i=0; $i<8; $i++) { $passwrd1 .= $passset[int(rand($#passset + + 1))]; } my $cryptedpass = crypt($passwrd1, substr($never_blank_value, 0, 2)); use Babel; my $y = new Babel; my $newpasswrd = $y->encode($cryptedpass, "$passwrd1");

    Since moving server the value of $cryptedpass is sometimes undef and throwing warnings from

New Meditations
Sum to 100 at Rosetta Code
2 direct replies — Read more / Contribute
by choroba
on Feb 17, 2018 at 12:52
    After a long time, I checked the list of tasks not implemented in Perl on RosettaCode. One of them was "Sum to 100", kind of similar to mjd's Simple but difficult arithmetic puzzle:

    In the string 123456789, you can prepend + or - before any digit to form an expression. You should

    • list all the possible expressions that evaluate to 100
    • show the number that is a result of the maximal number of expressions
    • show the lowest positive number that can't be expressed
    • show the ten highest numbers that can be expressed

    Here's my solution:

    I tried to avoid eval to evaluate the expressions, at the same time, I didn't want to implement the traditional full math expression parser as there were only two operations of the same precedence in use.

    $sum += $_ for $expression =~ /([-+]?[0-9]+)/g;

    Feel free to comment on perlishness, effectiveness, golfness, or beauty of the solution, or propose your own.

    Note: Those interested in Perl 6 can read the solution just below mine.

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
Do you like Perl?
4 direct replies — Read more / Contribute
by choroba
on Feb 13, 2018 at 15:21
    Do you like Perl? Do you count yourself among people?

    If both your answers are "Yes", you might want to add your reasons to the discussion Why do people like Perl? on

    I guess we've had similar threads here over the years, but talking to a broader auditorium can be different.

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
New Cool Uses for Perl
MCE gather and relay demonstrations
No replies — Read more | Post response
by marioroy
on Feb 13, 2018 at 00:32

    Fellow Monks,

    I received a request from John Martel to process a large flat file and expand each record to many records based on splitting out items in field 4 delimited by semicolons. Each row in the output is given a unique ID starting with one while preserving output order.

    Thank you, John. This is a great use-case for MCE::Relay (2nd example).

    Input File -- Possibly larger than 500 GiB in size

    foo|field2|field3|item1;item2;item3;item4;itemN|field5|field6|field7 bar|field2|field3|item1;item2;item3;item4;itemN|field5|field6|field7 baz|field2|field3|item1;item2;item3;item4;itemN|field5|field6|field7 ...

    Output File

    000000000000001|item1|foo|field2|field3|field5|field6|field7 000000000000002|item2|foo|field2|field3|field5|field6|field7 000000000000003|item3|foo|field2|field3|field5|field6|field7 000000000000004|item4|foo|field2|field3|field5|field6|field7 000000000000005|itemN|foo|field2|field3|field5|field6|field7 000000000000006|item1|bar|field2|field3|field5|field6|field7 000000000000007|item2|bar|field2|field3|field5|field6|field7 000000000000008|item3|bar|field2|field3|field5|field6|field7 000000000000009|item4|bar|field2|field3|field5|field6|field7 000000000000010|itemN|bar|field2|field3|field5|field6|field7 000000000000011|item1|baz|field2|field3|field5|field6|field7 000000000000012|item2|baz|field2|field3|field5|field6|field7 000000000000013|item3|baz|field2|field3|field5|field6|field7 000000000000014|item4|baz|field2|field3|field5|field6|field7 000000000000015|itemN|baz|field2|field3|field5|field6|field7 ...

    Example One

    This example configures a custom function for preserving output order. Unfortunately, the sprintf function alone involves extra CPU time causing the manager process to fall behind. The workers may idle while waiting for the manager process to respond to the gather request.

    use strict; use warnings; use MCE::Loop; my $infile = shift or die "Usage: $0 infile\n"; my $newfile = 'output.dat'; open my $fh_out, '>', $newfile or die "open error $newfile: $!\n"; sub preserve_order { my ($fh) = @_; my ($order_id, $start_idx, $idx, %tmp) = (1, 1); return sub { my ($chunk_id, $aref) = @_; $tmp{ $chunk_id } = $aref; while ( my $aref = delete $tmp{ $order_id } ) { foreach my $line ( @{ $aref } ) { $idx = sprintf "%015d", $start_idx++; print $fh $idx, $line; } $order_id++; } } } MCE::Loop::init { chunk_size => 'auto', max_workers => 3, gather => preserve_order($fh_out) }; mce_loop_f { my ($mce, $chunk_ref, $chunk_id) = @_; my @buf; foreach my $line (@{ $chunk_ref }) { $line =~ s/\r//g; chomp $line; my ($f1,$f2,$f3,$items,$f5,$f6,$f7) = split /\|/, $line; my @items_array = split /;/, $items; foreach my $item (@items_array) { push @buf, "|$item|$f1|$f2|$f3|$f5|$f6|$f7\n"; } } MCE->gather($chunk_id, \@buf); } $infile; MCE::Loop::finish(); close $fh_out;

    Example Two

    To factor out sprintf from the manager process, another way is via MCE::Relay for incrementing the ID value. Workers obtain the current ID value and increment/relay for the next worker, ordered by chunk ID behind the scene. Workers call sprintf in parallel. This allows the manager process (out_iter_fh) to accommodate up to 32 workers and not fall behind. It also depends on IO performance, of course.

    The MCE::Relay module is loaded automatically whenever the MCE init_relay option is specified.

    use strict; use warnings; use MCE::Loop; use MCE::Candy; my $infile = shift or die "Usage: $0 infile\n"; my $newfile = 'output.dat'; open my $fh_out, '>', $newfile or die "open error $newfile: $!\n"; MCE::Loop::init { chunk_size => 'auto', max_workers => 8, gather => MCE::Candy::out_iter_fh($fh_out), init_relay => 1 }; mce_loop_f { my ($mce, $chunk_ref, $chunk_id) = @_; my @lines; foreach my $line (@{ $chunk_ref }) { $line =~ s/\r//g; chomp $line; my ($f1,$f2,$f3,$items,$f5,$f6,$f7) = split /\|/, $line; my @items_array = split /;/, $items; foreach my $item (@items_array) { push @lines, "$item|$f1|$f2|$f3|$f5|$f6|$f7\n"; } } my $idx = MCE::relay { $_ += scalar @lines }; my $buf = ''; foreach my $line ( @lines ) { $buf .= sprintf "%015d|%s", $idx++, $line } MCE->gather($chunk_id, $buf); } $infile; MCE::Loop::finish(); close $fh_out;

    Relay accounts for the worker handling the next chunk_id value. Therefore, do not call relay more than once inside the block. Doing so will cause IPC to stall.

    Regards, Mario

Log In?

What's my password?
Create A New User
LanX God shaves the Queen!
[marto]: plastering
LanX citing Sean Connery

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (8)
As of 2018-02-19 10:34 GMT
Find Nodes?
    Voting Booth?
    When it is dark outside I am happiest to see ...

    Results (261 votes). Check out past polls.