Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

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.

poll ideas quest 2020
Starts at: Jan 01, 2020 at 00:00
Ends at: Dec 31, 2020 at 23:59
Current Status: Active
5 replies by pollsters
    First, read How do I create a Poll?. Then suggest your poll here. Complete ideas are more likely to be used.

    Note that links may be used in choices but not in the title.

Perl command line switches
4 direct replies — Read more / Contribute
by Irakro1997
on Mar 26, 2020 at 22:27
    Hi I recently started using Perl scripting again after a very long time so I inherited a scile file that I am playing with to get to work while trying to understand it I just recalled a useful command but I canít remember the name nor the exact usage so thought I would ask ...if you have inherited a Perl script that you quickly want to understand which arguments to pass on command line to generate out put files there is a command that you can use on the Perl script to get help on how to run that file or which arguments to pass to the script while running .... if that makes sense would someone here know these until commands ? Thanks
Oracle::DBD to 12c server
1 direct reply — Read more / Contribute
by jerryhone
on Mar 26, 2020 at 11:46
    We have an old application running on Solaris using Oracle:DBD that happily connects to an Oracle 11g server! $DBD::Oracle::VERSION = '1.14'; When trying to connect to a new 12c server we're encountering ORA-28040: No matching authentication protocol (DBD ERROR: OCISessionBegin) Google implies that we need to change sqlnet.allowed_logon_version on the server, but our DBA tells us that's not possible on our new dataserver setup! So, question is...will a newer version of Oracle::DBD solve our issues, and if so, what version do we need? If not, any other ideas?
Multidimensional arrays
3 direct replies — Read more / Contribute
by baxy77bax
on Mar 26, 2020 at 11:13

    Let say I have a multidimensional array and every time the number of dimensions is different. I don't have apriori information about the number of dimensions thus i need to recursively access each and figure out if there is more depth or not. But I also need to copy this array into another and modify it (let say increment). Curently I am trying to do it like this:

    sub new { my ($class) = @_; my $self->{_mtx_} = []; bless $self, $class; return $self; } sub copycomp_matrix { my ($self, $arg) = @_; $self->_recurse($arg,$self->{_mtx_}); print Dumper($self->{_mtx_}); } sub _recurse { my ($self, $in, $out) = @_; for (my $i = 0;$i<@{$in};$i++){ if (ref $in->[$i] eq 'ARRAY'){ $self->_recurse($in->[$i], $out->[$i]); }else{ if (!$out->[$i]){ $out->[$i] = $in->[$i] ; }else{ $out->[$i] = $in->[$i] +1 ; } } } } ######################################################### use strict; use lib "./"; use Above::Obj; my $z = Above::Obj->new(); my $a = [[1,2],[2,3]]; $z->copycomp_matrix($a);
    but I keep getting  $VAR1 = []; What am i missing ?? Is there a better way to do this ? thnx
Query of multi dimentional array
4 direct replies — Read more / Contribute
by shabird
on Mar 26, 2020 at 05:51

    Hello Monks, hope you all are fine

    I am struggling with multi dimensional array this time so basically the question goes like this, I have a file which has a data like this

    GeneID Tp1 Tp2 Tp3 ALA1 10 12 11 THR8 57 99 12 HUA4 100 177 199 ABA5 2 5 10

    So i have read the file and assigned it to multi dimensional array with the help of this code.

    my @content = (<FH>); close(FH); my $no_of_seq = scalar(@content); my @myArray; foreach my $row (@content) { my @columns = split(/\s+/,$row); push(@myArray,\@columns); # print "@columns"; } for($row = 0; $row < $no_of_seq; $row++){ for($col = 0; $col < $no_of_seq; $col++){ print($myArray[$row][$col], "\t"); } print("\n"); }

    so this code prints every element in the same order but now i want to calculate the sum of numbers in each row and print that sum next to gene name i.e sum of values for ALA1 is 33 and sum of values for THR8 is 168 and so on. Now i have tried something like this.

    for($row = 0; $row < $no_of_seq; $row++){ for($col = 0; $col < $no_of_seq; $col++){ $sum = $myArray[$row][$col] + $myArray[$row]; print($sum, "\t"); }

    But this is printing something like this

    140526414289424 140526414289424 140526414289424 1405264142894 +24 140526414289424 140526414212840 140526414212850 140526414212852 1405264142128 +51 140526414212840 140526414213296 140526414213353 140526414213395 1405264142133 +08 140526414213296 140526414288368 140526414288468 140526414288545 1405264142885 +67 140526414288368 140526414313944 140526414313946 140526414313949 1405264143139 +54 140526414313944

    How can i achieve my desired result? thank you in advance

LDAP Channel Binding
1 direct reply — Read more / Contribute
by chenson00
on Mar 25, 2020 at 14:59
    Hello Perl Wisefolk, my organization has long used a fairly simple LDAP implementation based on Net::LDAP. A key snippet of our code:
    my $netldap = Net::LDAP->new( $server, port => $port ); if ( $netldap ) { $conn = $netldap->bind( $self->{ 'user' }->{ 'ldapdn' }, password => $password ); ( $conn->code() ) ? die('LDAP ' . IBEX::_LOGIN::USER_LOOKUP::LOGIN_FAILED() ) : 1; #in Net::LDAP 0 = good login, true = bad login if ( $netldap ) { $netldap->unbind(); } }
    As you may know, Microsoft has raised concerns about Man-In-The-Middle attacks on insecure LDAP connections. Microsoft's recommendation is for system administrators to harden their LDAP configurations by requiring two things: LDAP Signing and LDAP Channel Binding.
    My understanding of these two concepts are as follows:

    What is LDAP Signing?
    LDAP signing is the process of digitally signing LDAP traffic.

    What is LDAP Channel Binding?
    LDAP channel binding refers to binding the TLS tunnel and the LDAP application layer together to create a unique fingerprint, called Channel Binding Token (CBT).

    For the LDAP Signing concern, I have found lots of helpful Perl documentation on ways to accomplish this using various combos of Net::LDAPS and Authen::SASL, so I think I'm good there.
    But for LDAP Channel Binding I am hitting a brick wall. I don't believe the implementing of LDAP Signing will "magically" also take care of LDAP Channel Binding.. this sounds like a different beast. Nor have I found any information on implementations of LDAP Channel Binding done in Perl. Has anyone dealt with this?
Regex AND NOT with zero-width negative lookahead assertion
3 direct replies — Read more / Contribute
by mldvx4
on Mar 25, 2020 at 07:39

    I am trying to use zero-width negative lookahead assertions to add an AND NOT logical clause to my pattern. I wish to match /aaa/ and /aaa\/aaa/ but not /aaa/aaa/ which is to say a span delimited by unescaped slashes. What I have so far matches too much:

    #!/usr/bin/perl use strict; use warnings; while (<DATA>) { # print $+{pattern},qq(\n) if ( # for now, show the whole line print if ( m, ^ (?!\x23) (?:.*?) (?<pattern> m? (?<delimiter>[/]) (?:(?:\\?+.)*?)*? \g{delimiter} ) ,x ); } __DATA__ #!/usr/bin/perl foo bar foo/bar /src/bin/oops/otehnoes if(/ok .*$/) { print "not OK\n"; } # skip a comment if(m/a good match/( { print "not ok\n"; } # do not /print/ this line either $string =~ s/[a-f]//g; # but print this line ( $string ) = ( $string =~ /(show this)/)); /but show\/this, too/ my $butdontprintthis = "/var/cache/dictionaries-common";

    However, I have not found a successful way to match /aaa/ while at the same time rejecting /aaa/aaa/

    What should I append towards the end of the pattern to ensure that /aaa/aaa/aaa/ and other similar strings are not accepted by the pattern yet /aaa/ alone would be? I have tried many scores of permutations of what to tack on, but no sucess yet. The script above produces the following result:

    /src/bin/oops/otehnoes if(/ok .*$/) { if(m/a good match/( { $string =~ s/[a-f]//g; # but print this line ( $string ) = ( $string =~ /(show this)/)); /but show\/this, too/ my $dontprint this = "/var/cache/dictionaries-common";

    But it should produce the following instead:

    if(/ok .*$/) { if(m/a good match/( { $string =~ s/[a-f]//g; # but print this line ( $string ) = ( $string =~ /(show this)/)); /but show\/this, too/
Function for reading file
2 direct replies — Read more / Contribute
by shabird
on Mar 25, 2020 at 05:29

    Hi Monks! I have a file which i read and extract information from it, the file contents is as follows:

    DATA Numbers five; Crystal; Reliable chromo; Onion; Apple; Salt. CHEM Synechocystis sp. PCC 6803 substr. Kazusa NAMES Synechocystis sp. PCC 6803 substr. Kazusa Bacteria; Cyanobacteria; Synechococcales; Merismopediaceae +; Synechocystis; unclassified Synechocystis.

    I am extracting only DATA and its corresponding values. For this i wrote the following program.

    open(FH, "/Users/Desktop/file.txt") or die; my $content = join("", <FH>); close(FH); my @matches = $content =~ /DATA\s+([A-Za-z\W]+)\n/g; print "Data:@matches\n";

    Now everything works file but i want to use a subroutine for this task, where the subroutine takes as input argument the content of the file and returns all data (DATA) from the file. In the return argument only the DATA should be included and nothing else.

    How can i achieve this? any inputs will be appreciated a lot :)

Scrollbars in Curses::UI?
1 direct reply — Read more / Contribute
by Muskovitz
on Mar 25, 2020 at 05:27

    Is there a way to create a scrolling functionality in Curses::UI?
    Stated here: Curses::UI::Widget#SCROLLBARS:

    Since the user of a Curses::UI program has no real control over the so + called "scrollbars", they aren't really scrollbars. A better name wo +uld be something like "document location indicators". But since they +look so much like scrollbars I decided I could get away with this nam +ing convention.

    So I did try, here's my code:
    my $container = $win1->add( 'vulnerability', 'Container', -title => "List of Street Addr", -height => 50, -border => 1, -y => 1, -width => 60, -height => 20, -bfg => 'blue', -vscrollbar => "right", -vscrolllen => 20 );
    I have really no control over the scrollbar, So if any of you knows how to get around this. Please enlighten me. Thanks.

Strawberry + Padre - is this real?
3 direct replies — Read more / Contribute
by twostime
on Mar 24, 2020 at 15:30

    Hello lovely mungers,

    I read this thread. I'm returning to Perl for an easy solution to an important problem (child safety system) . I took advice and noted Strawberry Perl was ok, latest install is this month and SHA1 is good! Got to be a worthwhile endeavour.

    I installed said varient and read their readme.txt. I'm keen on a helpful IDE so used their readme to install Padre.

    OMG - that is the most painful and frightening installation i've ever seen. I have no idea what I have done to my new PC. So many warnings and some fails. test summary:

    Test Summary Report ------------------- t/10_cleanup.t (Wstat: 512 Tests: 2 Failed: 0) Non-zero exit status: 2 t/11_cleanup.t (Wstat: 512 Tests: 4 Failed: 0) Non-zero exit status: 2 Files=25, Tests=533, 5 wallclock secs ( 0.08 usr + 0.06 sys = 0.14 +CPU) Result: FAIL Failed 2/25 test programs. 0/533 subtests failed. gmake: *** [Makefile:784: test_dynamic] Error 255 ADAMK/ORLite-1.98.tar.gz C:\STRAWB~1\c\bin\gmake.exe test -- NOT OK //hint// to see the cpan-testers results for installing this module, t +ry: reports ADAMK/ORLite-1.98.tar.gz Stopping: 'install' failed for 'ORLite'. C:\Strawberry>

    I'm keen to know whether this is a usual deployment, if I need to worry (have no full log but can share what I captured at the end). I thought PERL was a living language. I do not believe the Monks have all past on due to C19 :) love a little help here, v basic reqs. Ta. (Sorry can't cope with dictatorial formatting - the help wasn't very - i'll try harder next time)

RFC / Audit: Mojo Login Example
4 direct replies — Read more / Contribute
by haukex
on Mar 22, 2020 at 05:51

    Hi everyone,

    Over at Re: 302 Found Location Message I posted an example of some login code with Mojolicious. I've now expanded that code to add a brute force attack deterrent. I would greatly appreciate a set of critical eyes - are there any gaps in the protection, and is there something else I'm missing to improve the security even more? (I've thought about hashing the password on the client side, but I'd prefer not to make it dependent on JavaScript - HTTPS will have to do for now.) For example, I could add a delay for each remote IP with failed login attempts, or I could grow the delay time exponentially.

Looking for a function that returns status of a scalar's numeric flags
4 direct replies — Read more / Contribute
by syphilis
on Mar 22, 2020 at 02:06

    By "numeric flags", I'm referring to the "IOK", "pIOK", "NOK", "pNOK" and the "IsUV" flags (as presented by Devel::Peek::Dump).
    But rather than have this information displayed, I'm looking for a sub that returns the status of these specific flags. That is, something like:
    sub flag_status { my $v = $_[0]; return is_IOK($v) | is_pIOK($v) | is_IsUV($v) | is_NOK($v) | is_pNOK($v); } sub is_IOK { # return 1 if argument's IOK flag is set # else return 0 } sub is_pIOK { # return 2 if argument's pIOK flag is set # else return 0 } sub is_NOK { # return 4 if argument's NOK flag is set # else return 0 } sub is_pNOK { # return 8 if argument's pNOK flag is set # else return 0 } sub is_IsUV { # return 16 if argument's IsUV flag is set # else return 0 }
    The aim is to be able to determine whether a subroutine call changes the status of any of those flags on the subroutine's argument. That is:
    my $d = 2.7; my $flags_prior = flag_status($d); foo($d); my $flags_after = flag_status($d); die "foo() altered its argument's numeric flags" if($flags_prior != $flags_after);
    Is there already a perl module that ships with the core that will return the status of those 5 flags ?
    Is there already a module on CPAN that will return the status of those 5 flags ?

    I know how to find the status of "IOK", "NOK" and "IsUV" in XS.
    One can merely test the truth of SvIOK(sv), SvNOK(sv) and SvUOK(sv) respectively.
    But how does one establish, in XS, whether the "pIOK" and "pNOK" flags are set ?

    Maybe there's another way to approach this.
    The key thing is that I want to be able to programmatically catch the occurrence of foo() altering its argument's "numeric flags".

Cool Uses for Perl
Statistics::Covid : module for fetching and storing covid19-related data for analysis
2 direct replies — Read more / Contribute
by bliako
on Mar 26, 2020 at 15:42

    Fellow Monks,

    I have just submitted to CPAN a very alpha release of a module which collects data from various online providers of Covid19-related statistics (e.g. number of confirmed cases etc.). For example, data provided by John Hopkins University (as an arcgis "dashboard") or the data provided by the UK government for data relating to the UK local authorities.

    All the providers I used (so far, John Hopkins University and the UK government) offer an API which provides JSON data. The scraper can be easily configured (that is subclassed) to set the url entry point to the API and how data should be converted to a Perl object. So, it is relatively easy to create more data fetchers which can all store to the same db.

    Fetched data is stored in an SQLite database (support for MySQL exists but remains untested and probably broken - but easily fixed) and there is a high-level interface (thank you DBIx::Class) for saving and retrieving this data. This makes it easy to save data points only if they are more "up-to-date" than what currently exists in database, for the same location and time point (using heuristics). Or, it allows to retrieve all data for a single location over time, or for a single time point/range over all or some locations.

    The CPAN module is Statistics::Covid. It is also hosted on github at which additionally provides the data I have so far collected since a couple of weeks ago.

    If anyone has any comments or suggestions please leave me a message.

    If anyone wishes to contribute, e.g. data analysis or plots generation, under this or any other namespace, please let me know so that I link to that work. I am also starting to write my own analysis which will be under the namespace: Statistics::Covid::Analysis.

    Here is some code from the synopsis as a quick start:

    use Statistics::Covid; use Statistics::Covid::Datum; $covid = Statistics::Covid->new({ 'config-file' => 't/example-config.json', 'providers' => ['UK::BBC', 'UK::GOVUK', 'World::JHU'], 'save-to-file' => 1, 'save-to-db' => 1, 'debug' => 2, }) or die "Statistics::Covid->new() failed"; # fetch all the data available (posibly json), process it, # create Datum objects, store it in DB and return an array # of the Datum objects just fetched (and not what is already in D +B). my $newobjs = $covid->fetch_and_store(); print $_->toString() for (@$newobjs); print "Confirmed cases for ".$_->name() ." on ".$_->date() ." are: ".$_->confirmed() ."\n" for (@$newobjs); my $someObjs = $covid->select_datums_from_db({ 'conditions' => { belongsto=>'UK', name=>'Hackney' } }); print "Confirmed cases for ".$_->name() ." on ".$_->date() ." are: ".$_->confirmed() ."\n" for (@$someObjs); # or for a single place (this sub sorts results wrt publication ti +me) my $timelineObjs = $covid->select_datums_from_db_for_location('Hac +kney'); for my $anobj (@$timelineObjs){ print $anobj->toString()."\n"; } print "datum rows in DB: ".$covid->db_count_datums()."\n"

    BW, bliako

Log In?

What's my password?
Create A New User
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (3)
As of 2020-03-28 16:46 GMT
Find Nodes?
    Voting Booth?
    To "Disagree to disagree" means to:

    Results (167 votes). Check out past polls.