Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic

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
variables passed from main to package
1 direct reply — Read more / Contribute
by FryingFinn
on Feb 21, 2018 at 20:38
    I trying to get an application to set a couple of Global (?) variable that will be used in package subroutines. I thought I could use  $main::DEBUG my test main is
    #!/usr/bin/perl ## this is perl5.16 my $DEBUG = 1233; my $VERBOSE=5; use strict; use warnings; use Getopt::Long; my $Usage = "this is Usage"; Getopt::Long::GetOptions( 'd=i' => \$DEBUG, 'v=i' => \$VERBOSE ) or die "Incorrect u +sage! $Usage\n"; print "in MAIN DEBUG is $DEBUG \n"; print "In Main VERBOSE is $VERBOSE \n"; use lib "../lib"; use myApp; myApp::testprint(); myApp::testprint2();
    The code for is
    package myApp; my $DEBUG = $main::DEBUG; my $VERBOSE = $main::VERBOSE; print " has DEBUG [$DEBUG]\n"; print " has VERBOSE [$VERBOSE]\n"; 1; sub testprint { print "in myApp::testprint DEBUG is [$DEBUG]\n"; print "in myApp::testprint VERBOSE is [$VERBOSE]\n"; } sub testprint2 { my $DEBUG = $main::DEBUG; my $VERBOSE = $main::VERBOSE; print "in myApp::testprint2 DEBUG is [$DEBUG]\n"; print "in myApp::testprint2 VERBOSE is [$VERBOSE]\n"; }
    The results.
    ./xVERBOSE has DEBUG [] has VERBOSE [] in MAIN DEBUG is 1233 In Main VERBOSE is 5 in myApp::testprint DEBUG is [] in myApp::testprint VERBOSE is [] in myApp::testprint2 DEBUG is [] in myApp::testprint2 VERBOSE is []
    any help would be appreciated tks gerry
Make a CPAN module
4 direct replies — Read more / Contribute
by mpersico
on Feb 21, 2018 at 09:42
Counting PDL vectors in a PDL matrix
3 direct replies — Read more / Contribute
by mxb
on Feb 20, 2018 at 04:19

    Hi all, I am currently learning PDL and I've come up against a situation for which I cannot figure out how to proceed. I have a 2D array, comprised of multiple 1D byte vectors which may or may not be unique. I wish to count the number of unique vectors within the array - essentially a histogram of vector counts. My data is too big for here, but the following example demonstrates the issue I am having.

    pdl> p $x [ [0 1 2] [3 4 5] [6 7 8] [0 1 2] [0 1 2] [6 7 8] ]

    I know I can retrieve a list of unique elements:

    pdl> p uniq $x [0 1 2 3 4 5 6 7 8]

    I know I can retrieve a histogram of all elements:

    pdl> p scalar hist $x,0,256,1 [3 3 3 1 1 1 2 2 2 0 0 0 0 0 ....]

    What I would like is something like the following output:

    [0 1 2] 3 [3 4 5] 1 [6 7 8] 2
    I think my issue stems from the fact that PDL is designed for operations on PDL elements. I am currently contemplating if the best solution to my problem is to have a lookup table of the data I am putting in vectors to an index, for example:
    my %lookup = ( 0 => "0 1 2", 1 => "3 4 5", 2 => "6 7 8", ); # Then $x reduces down to $x = [ 0 1 2 0 0 2 ];

    Any advice would be welcome, as both PDL and numerical computing are new to me, thanks!

Date::Parse - how to correctly parse dates between 1901 and 1969
6 direct replies — Read more / Contribute
by eniad
on Feb 19, 2018 at 14:29

    I am parsing dates and datetimes input by users who aren't too careful with their formatting. Date::Parse seems great because it handles most cases I need to handle.

    Except datetimes between 1901-01-01 00:00:00 and 1968-12-31 23:59:59, as I found out today. For those datetimes, Date::Parse str2time adds an extra 100 years when it parses the datetime to epoch time.

    Here is the code I am using to parse the datetimes:

    #!/usr/bin/perl #--------------------------------------------------------------------- # # # format variable date inputs #--------------------------------------------------------------------- use strict; use warnings; use Date::Parse; use DateTime; my $DEFAULT_TIME_ZONE = "GMT"; my @dates = ( "1899-06-24 09:44:00", "1900-12-31 23:59:59", "1901-01-01 00:00:00", "1960-12-31 23:59:59", "1966-06-24 09:44:00", "1968-12-31 23:59:59", "1969-01-01 00:00:00", "1969-12-31 23:59:59", "1970-01-01 00:00:01", "2000-01-01 00:00:00", "2017-06-24 23:59:59", "2018-06-24 09:44:00", "2238-06-24 09:44:00" ); foreach my $string (@dates) { # format datetime field from any valid datetime input # default time zone is used if timezone is not included in string my $epoch = str2time( $string, $DEFAULT_TIME_ZONE ); # error if date is not correctly parsed if ( !$epoch ) { die("ERROR ====> invalid datetime ($string), " . "datetime format should be YYYY-MM-DD HH:MM:SS"); } my $date = DateTime->from_epoch( epoch => $epoch ); printf( "formatting datetime: value = %20s, epoch = %20u, " . "date = %20s\n", $string, $epoch, $date ); } exit 0;

    Side note: I need to improve my error handling because the valid date 1970-01-01 00:00:00 will throw an error.

    The additional 100 years for dates between 1901 and 1969 can be seen in the output:

    formatting datetime: value = 1899-06-24 09:44:00, epoch = 18446744071 +484095456, date = 1899-06-24T09:44:00 formatting datetime: value = 1900-12-31 23:59:59, epoch = 18446744071 +532098815, date = 1900-12-31T23:59:59 formatting datetime: value = 1901-01-01 00:00:00, epoch = +978307200, date = 2001-01-01T00:00:00 formatting datetime: value = 1960-12-31 23:59:59, epoch = 2 +871763199, date = 2060-12-31T23:59:59 formatting datetime: value = 1966-06-24 09:44:00, epoch = 3 +044598240, date = 2066-06-24T09:44:00 formatting datetime: value = 1968-12-31 23:59:59, epoch = 3 +124223999, date = 2068-12-31T23:59:59 formatting datetime: value = 1969-01-01 00:00:00, epoch = 18446744073 +678015616, date = 1969-01-01T00:00:00 formatting datetime: value = 1969-12-31 23:59:59, epoch = 18446744073 +709551615, date = 1969-12-31T23:59:59 formatting datetime: value = 1970-01-01 00:00:01, epoch = + 1, date = 1970-01-01T00:00:01 formatting datetime: value = 2000-01-01 00:00:00, epoch = +946684800, date = 2000-01-01T00:00:00 formatting datetime: value = 2017-06-24 23:59:59, epoch = 1 +498348799, date = 2017-06-24T23:59:59 formatting datetime: value = 2018-06-24 09:44:00, epoch = 1 +529833440, date = 2018-06-24T09:44:00 formatting datetime: value = 2238-06-24 09:44:00, epoch = 8 +472332640, date = 2238-06-24T09:44:00

    The Date::Parse documentation suggests it can handle dates at least as old at 1901-01-01. The Time::Local documentation suggest it should be able handle dates even older.

    How should I handle this oddity? Is there a better way to parse variable input formats?

Failed to find share dir for dist 'Dancer2'
2 direct replies — Read more / Contribute
by markong
on Feb 19, 2018 at 07:13
    Hello, I've cloned the Dancer2 official git repo and now I'm trying to setup a dev environment (inside a perlbrew local lib) and I'm stuck at this command, receiving back:
    Failed to find share dir for dist 'Dancer2' at lib/Dancer2/CLI/Command/ line 62.
    which I guess is to be expected seen that I haven't installed the 'Dancer2' dist from CPAN and File::ShareDir::dist_dir('Dancer2') will fail.

    I'm trying to execute the dancer script from the cloned checkout code base, in order to setup a test dancer2 project, but it seems that it is not something supported?!

    I'm wondering if anybody has experience with the code base and can suggest something. Is the Dancer2 distro installation from CPAN mandatory to execute the 'dancer2' script or else how do you call that 'script/dancer2' bin around that share dir check while developing?

creating and managing many hashes
7 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?

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,
Log In?

What's my password?
Create A New User
and all is quiet...

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

    Results (288 votes). Check out past polls.