Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

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.

Quests
poll ideas quest 2020
Starts at: Jan 01, 2020 at 00:00
Ends at: Dec 31, 2020 at 23:59
Current Status: Active
3 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.

Supplications
Find element in array
6 direct replies — Read more / Contribute
by Sofie
on Feb 16, 2020 at 07:36
    Hi I am very new to perl and struggling with simple things... I am trying to check if an input DNA sequence only contains nucleotides. And if it doesn't I want to print out the position in the sequence where an invalid character was entered. This is as far as I have come:
    #!/usr/bin/perl -w $DNA = <STDIN>; chomp ($DNA); @DNA = split ("", $DNA); $lengthseq = scalar @DNA; print "The length of the sequence is:\n", $lengthseq, "\n"; @nucleotideDNA = ""; #check if each element in array is nucleotide foreach $nucleotide (@DNA){ if ($nucleotide =~ /^[ATCG]+$/){ push @nucleotideDNA, $nucleotide; } else { push @nonvalid, $nucleotide; } }
    But how can I print the position of the non valid character? Not sure if this makes any sense.. Thanks
Match something that does not match
1 direct reply — Read more / Contribute
by jo37
on Feb 15, 2020 at 12:42
    Hi,

    every now and then I stumble upon the question of how to match something that doesn't match something else. I.e. some expression in the sense of [^...]* for a general given regex $match. The best I got so far is:

    my $does_not_match = qr{((?:.*?(?=$match))|(?:(?:.(?!$match))*))};

    The first branch matches a substring up to the given regex $match if there is a match and the second branch matches the whole string if there is no match. Both fail in the opposite case. (The second branch by missing the last character.)

    Does anybody know something simpler? Or do you see any issues with the given regex?

    Here is a small example:

    #!/usr/bin/perl use Test2::V0; sub do_not_match { my $pat = shift; return qr{(?:.*?(?=$pat))|(?:(?:.(?!$pat))*)}; } my $re = do_not_match(qr{\b[aeiou][a-z]*ion\b}); is [/($re)/], ['stimulated '], 'matches prefix' for 'stimulated emission of radiation'; is [/($re)/], ['electron transition'],'no match' for 'electron transition'; is [/($re)/], [''], 'matches empty prefix' for 'absorbtion of photons'; is [/($re)/], ['light '], 'matches not greedy' for 'light amplification by stimulated emission of radiation'; is [/($re)\bimpact/], ['electron '], 'gives characters back' for 'electron impact ionization'; done_testing;

    I might put this into an extension module for Regexp::Common, but I'm not sure if this makes sense at all. And what would a proper naming be? Maybe something like:

    use Regexp::Common 'do_not_match'; my $re = $RE{do_not}{-match => 'something'}

    Your opinions?

    -jo

wiki regex reprocessing replacement
4 direct replies — Read more / Contribute
by LanX
on Feb 15, 2020 at 09:39
    Hi

    Task

    I need a regex to transform wiki markup surrounding words to html, * to <b> etc.

    my problem is that */_ could be combined at word boundaries, see the following example

    DB<66> $_=$wiki; tf();tf();tf() ; print "'$wiki' \n=>\n'$_'" '_*one /two/*_ _*three /four/*_ _*five /six/*_' => '<u><b>one <i>two</i></b></u> <u><b>three /four/</b></u> <u><b>five <i +>six</i></b></u>' DB<67>
    '_*one /two/*_ _*three /four/*_ _*five /six/*_'
    =>
    'one two three /four/ five six'
    

    as you can see I have to run the tf() transformation thrice

    DB<40> %h = ( '*'=>'b', '/' => 'i' , '_' => 'u' ) DB<59> sub tf { s{ $pre ([_*/]) (.*?) \2 $post}{$1<$h{$2}>$3</$h{$2} +>$4}xg } DB<62> $pre = qr/(^|\s|>)/ DB<63> $post = qr/($|\s|<)/ DB<65> $wiki='_*one /two/*_ _*three /four/*_ _*five /six/*_'

    Question

    Is there a way to make it a one-run transformation?

    Trouble is that /g continues after the inserted replacement, here underline

    I was experimenting with lookaround-assertions and \G and couldn't get it done.

    Approaches

    The only ways I can (theoretically) think of so far are

    • to loop over /g in scalar context while (s///g) { ... } and to manipulate pos
    • or to manipulate pos in an embedded Perl code (?{...})
    • to call tf() recursively in the /e evaled replacement part
    NB: It's a more theoretical question because running tf() three times doesn't pose problems.

    UPDATE:

    I just noticed a bug, since four wasn't expanded.

    &tf has to be better written with a lookbehind which doesn't consume the next whitespace

    DB<90> sub tf { s{ $pre ([_*/]) (.*?) \2 (?=$post)}{$1<$h{$2}>$3</$h +{$2}>}xg }

    I'll update an SSCCE soon.

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

DBI, DBD::Oracle, Inconsistent Fetch Failures
1 direct reply — Read more / Contribute
by perldigious
on Feb 14, 2020 at 17:54

    Hi Monks,

    So I'm still having major issues with inconsistent/intermittent data fetch failures from my company's Oracle DB. I've been digging, a lot, and I may have narrowed down the issue further based on some earlier suggestions from the Monastery... but I still don't have a solid solution. I think this is an Oracle DB datatype issue, where there is a mismatch between what the DB has and DBD::Oracle is expecting, but being a newbie I'm not sure that's correct. Here is the relevant portion of the script I'm currently trying and using tracing options on to try and debug further.

    use strict; use warnings; use DBI; use DBD::Oracle qw(:ora_types); print "Establishing DWASAS connection...\n"; # establish database connection and enable tracing option with dump to + 'tracelog.txt'. my $dsn = 'dbi:Oracle:DWASAS'; my @connection = ($dsn, $user, $pass, {InactiveDestroy => 1, PrintErro +r => 0, RaiseError => 1}); my $dbh = DBI->connect(@connection) or die; open(my $tracelog_fh, '>', 'tracelog.txt') or die "Cannot open \"trace +log.txt\": $!."; $dbh->trace(4, $tracelog_fh); # pepare and execute 'prepack_candidates.sql' print "Preparing 'prepack_candidates.sql'...\n"; my $sth1 = $dbh->prepare($candidates_sql) or die; print "Executing 'prepack_candidates.sql'...\n"; $sth1->execute() or die; print "Fetching 'prepack_candidates.sql' returned data...\n"; print "\n----------\n"; my $print_format = '%7s '. '%-50s '. '%11s '. '%12s' ; printf("$print_format\n", 'ROW_NBR', 'REPORT_PART_NBR', 'SHIPPED_QYT', 'COUNT_AT_QTY' ); my $row_counter = 1; while(my $row = $sth1->fetchrow_hashref) { foreach (keys(%$row)) {$row->{$_} = '' if (!defined($row->{$_}))}; + # change all NULLs to empty strings printf("$print_format\n", $row_counter, $row->{'REPORT_PART_NBR'}, $row->{'SHIPPED_QTY'}, $row->{'COUNT_AT_QTY'} ); $row_counter++; } print "----------\n";

    And here is the basic SQL query it's running. And yes, it is successfully running, I can run this same query in 3 other tools: SQL Developer, Alation, and SAS (SAS modified for proc sql))

    The failure happens during the $sth1->fetchrow_hashref loop. If I try various CASTs in the SQL it will tend to get hung up on different rows of data, but at this point rarely finishes successfully. But here's where things get interesting. The trace file, when it fails the fetch, just looks like this.

    But, way back up at the top, when it's doing the prepare statement, the datatypes don't match what I would expect. When I look at them in the DB tables shown in Alation, Alation says one is a VARCHAR2(50) and the other is a NUMBER(10). I'm not sure what the COUNT I'm doing would become, but I was guessing NUMBER of some size as well.

    So, for those Monks that know DBI and especially DBD::Oracle well, or any Monk who has an opinion really... thoughts that may help me?

    Just another Perl hooker - My clients appreciate that I keep my code clean but my comments dirty.
How to export hash references
1 direct reply — Read more / Contribute
by Anonymous Monk
on Feb 14, 2020 at 06:03
    I'm trying to export a reference to a hash but can only access it with a fully-qualified name. What am I doing wrong? Thanks

    Package Foo; use strict; use warnings; use Exporter 'import'; our @ISA = qw[Exporter]; our @EXPORT_OK = qw[%env $env]; our %env = %ENV; our $env = \%ENV; 1;
    
    perl -I. -MFoo=%env -le 'print scalar keys %env'
    38
    
    perl -I. -MFoo=$env -le 'print scalar keys %$env'
    0
    
    perl -I. -MFoo=$env -le 'print scalar keys %$Foo::env'
    38
    
scripting a perl install on *nix, including making the workstation usable
2 direct replies — Read more / Contribute
by Aldebaran
on Feb 11, 2020 at 16:59

    Hello esteemed monks,

    This thread is to be seen as a continuation of Using Cartons to automate module installs, where, instead of Cartons, we went with cpanfiles. I worked up a bash command that takes a module list and creates a cpanfile:

    $ cat 1.list.cpan |perl -lpe "s{^}{requires '};s{$}{', 'undef';};" >cp +anfile $ cat cpanfile requires 'App::cpanminus', 'undef'; requires 'CPAN', 'undef'; requires 'CPAN::DistnameInfo', 'undef'; requires 'CPAN::Meta::Check', 'undef'; requires 'Log::Log4perl', 'undef'; requires 'Module::Runtime', 'undef'; requires 'PadWalker', 'undef'; requires 'Path::Tiny', 'undef'; requires 'Perl::Tidy', 'undef'; requires 'YAML', 'undef'; $

    The outstanding question is how it would go down in the target environment, and I think the answer is "flawlessly:"

    $ ./3.cpan_dir.sh mkdir: cannot create directory ‘logs’: File exists /home/gilligan/Documents/Documents/hogan mkdir: cannot create directory ‘cpan_file_dir7’: File exists /home/gilligan/Documents/Documents/hogan/cpan_file_dir7 requires 'App::cpanminus', 'undef'; requires 'CPAN', 'undef'; requires 'CPAN::DistnameInfo', 'undef'; requires 'CPAN::Meta::Check', 'undef'; requires 'Log::Log4perl', 'undef'; requires 'Module::Runtime', 'undef'; requires 'PadWalker', 'undef'; requires 'Path::Tiny', 'undef'; requires 'Perl::Tidy', 'undef'; requires 'YAML', 'undef'; [sudo] password for gilligan: --> Working on . Configuring /home/gilligan/Documents/Documents/hogan/cpan_file_dir7 .. +. OK ==> Found dependencies: Perl::Tidy, YAML, Path::Tiny, Log::Log4perl, C +PAN::DistnameInfo, CPAN::Meta::Check --> Working on Perl::Tidy Fetching http://www.cpan.org/authors/id/S/SH/SHANCOCK/Perl-Tidy-202001 +10.tar.gz ... OK ... Successfully installed CPAN-Meta-Check-0.014 <== Installed dependencies for .. Finishing. 11 distributions installed behold your output: App::cpanminus CPAN::DistnameInfo CPAN::Meta::Check Log::Log4perl Path::Tiny Perl Perl::Tidy Spiffy Test::Base Test::Deep Test::YAML Text::Diff YAML duration=298 Tue Feb 11 12:37:58 PST 2020 $

    The "output" here is a bash wrapper around this:

    #!/usr/bin/perl -w use 5.016; use ExtUtils::Installed; my $inst = ExtUtils::Installed->new(); my @modules = $inst->modules(); foreach my $module (@modules){ print $module . "\n"; } __END__

    The modules I put in this list are ones I consider essential to having a usable perl capability. I might install them as a vanguard.

    Q1) What might you add to a list of useful modules to have from the git-go? For example, what might be a good cpanfile to have to deal with universal time?

    I would like to take this discussion in a different direction than usual, and I hope not to hit a third rail. As a person who has only used his computer skills "under the table," that is, in the cash economy for small gigs, I'm wondering what the job title is of a person who gets paid over the table to configure and maintain work stations for others in a company. Is it a systems administrator or a network adminstrator? Q2) Do you happen to be such a person who has had or is currently in such a post?

    Q3) (Here's the one I'm really fishing for) What certifications does one need to be considered for such a post? I have an opportunity to get some continuing education, but I need to be specific about things I hope to achieve.

    I hope the questions aren't too Ami-centric. Heck, let me also ask, Q4) Are these certifications the same around the world?

    Thanks for your comment,

regex for nested "<"/">'
5 direct replies — Read more / Contribute
by clueless newbie
on Feb 11, 2020 at 15:41

    I've taken this from Conway's "Everything You Know About Regexes Is Wrong", but I can't get it to behave.

    #!/usr/bin/env perl use 5.01800; use warnings; my @cases=( "<1>" ,"<1,2>" ,"<1,2,<3,4>,5,6>" ); my $re=qr{(?x) (?&LIST) (?(DEFINE) (?<LIST> < (?&ITEM) (?: , (?&ITEM))*+ > ) (?<ITEM> \d*+ | (?&LIST) ) ) }; for my $case (@cases) { say qq{$case\n}, $case =~ qr{$re} ? "matches: '$&'" : "doesn't match"; }; __END__

    which yields

    perl Conway_01.pl <1> matches! <1> <1,2> matches! <1,2> <1,2,<3,4>,5,6> matches! <3,4> !!!! shouldn't this be <1,2,<3,4>,5,6>

    What have I got wrong?

Nested iterations throgh hash
3 direct replies — Read more / Contribute
by luxs
on Feb 11, 2020 at 14:52
    I do need to do few nested iterations through hash and they are not working properly (thertically i do understand why).
    my $h = {'a'=>1, 'b'=>2, 'c'=>3, 'd'=>4,}; while( my ($k1, $v1) = each(%$h)) { say "external $k1 => $v1"; while( my ($k2, $v2) = each(%$h)) { say "internal $k2 => $v2"; } }
    But what is the best practical solution for this task? 1. use dclone to have two hash copies - good when they are not huge 2. use array with proper indexing instead of hash
Sometimes undef is initialized and sometimes not when hash values are fed to grep
3 direct replies — Read more / Contribute
by leszekdubiel
on Feb 11, 2020 at 11:21

    Hello Perl Monks!

    In perl5 there is a strange behaviour that hash values are sometimes initialized to undef and sometimes not. See this example:

    #!/usr/bin/perl -CSDA use utf8; use Modern::Perl; no warnings qw{uninitialized numeric}; use Data::Dumper; my %h = (a => 'alfa', b => 'beta'); print "\n\nfirst try:\n"; print "\t>>$h{a}<<\n"; print "\t>>$h{XXX}<<\n"; print "\t>>$h{b}<<\n"; print "after first:\n", Dumper(\%h); print "\n\nsecond try:\n"; print map { "\t>>$_<<\n" } $h{a}, "mytext" . $h{YYY} . "after", $h{b}; print "after second:\n", Dumper(\%h); print "\n\nthird try:\n"; print map { "\t>>$_<<\n" } $h{a}, $h{ZZZ}, $h{b}; print "after third:\n", Dumper(\%h); ===================== OUTPUT: first try: >>alfa<< >><< >>beta<< after first: $VAR1 = { 'a' => 'alfa', 'b' => 'beta' }; second try: >>alfa<< >>mytextafter<< >>beta<< after second: $VAR1 = { 'a' => 'alfa', 'b' => 'beta' }; third try: >>alfa<< >><< >>beta<< after third: $VAR1 = { 'b' => 'beta', 'ZZZ' => undef, <<<<<<------------ ?????? 'a' => 'alfa' };

    Hash values are only used to form strings. Why sometimes they got initialized to "undef" and sometimes not? Does Raku (Perl6) has similiar behaviour?

    This is what I asked in autovivification context: https://www.perlmonks.org/?node_id=11110437.

Tk text scrollbar autohide
1 direct reply — Read more / Contribute
by Anonymous Monk
on Feb 11, 2020 at 10:54

    I am learning Tk. I want that the text widget displays the vertical scrollbar only if this is needed, otherwise it should hide. This is normal practice today. In the Widget POD I could not find any reference to this feature, so I guess it does not exist. Has anybody been able to achieve this? On the Internet I only found a Python code, but I do not speak Python. Any suggestion?

Morse input from keyboard
6 direct replies — Read more / Contribute
by pierrot
on Feb 10, 2020 at 18:44
    I'd like to write a Perl script to do something similar to this website. The idea is that you press a single key and depending on how long you press it, that stroke is interpreted as a dot or a dash. I searched for a CLI o GUI program to do this task and found none so I'd like to write my own in Perl. Any ideas/suggestions?
PERL REST API Post script
5 direct replies — Read more / Contribute
by ptone
on Feb 10, 2020 at 15:51
    Hi Team, I am trying to use arguments to pass information from the command line into a perl script. These are the IP, Email, the User and the password. The IP works but the rest does not get parsed into the req for the content. If I hardcode these the script works.
    ##!/usr/bin/perl -l use strict; use warnings; use LWP::UserAgent; my $username = "Polycom"; my $password = "789"; my $phoneip = $ARGV[0]; my $user = $ARGV[1]; my $Address = $ARGV[2]; my $passcode = $ARGV[3]; my $ua = LWP::UserAgent->new( ssl_opts => { verify_hostname => 0 }, protocols_allowed => ['https'], ); my $URL = "https://$phoneip/api/v1/mgmt/skype/signIn"; { # Create the request object and add the authentication header and cont +ent my $req = HTTP::Request->new(POST => $URL); $req->content_type('application/json'); $req->authorization_basic( $username, $password ); $req->content('{"data":{"Address": "$Address","User": "$user","Passw +ord": "$passcode","Domain":"","LockCode":""}}'); # Send the request to the user agent and print the result my $response = $ua->request($req); print "\r\n"; print $response->decoded_content; }
    With the above, I am trying to help one of our customers to remotely sign into a Phone but I cannot parse the info. It must be something little but I am stuck. Could someone kindly help me out? I actually managed the same in Power Shell but I like to offer various examples to them. Best Regards Steffen
PerlMonks Discussions
Chatterbox: NEW link to sent messages
No replies — Read more | Post response
by LanX
on Feb 16, 2020 at 07:11
    Hi

    Private /msg [messages] are sometimes hard to understand if they are a reply to something you wrote a day ago.

    Actually they are still available in the "Delete" folder but only for a limited time (36h ?)

    click here to check

    The chatterbox nodelet used to have various links to the message box in the bottom row

      • And 69 more, 90 archived
    

    It now contains a link to recently sent messages too

      • And 69 more, 90 archived, recently sent
    

    The "recently" was necessary to avoid confusion about older messages missing. You need to archive them explicitly if you want keep them longer. °

    Thanks to the gods for accepting my patch. :)

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

    °) The link is a bit long for my taste, probably "just sent" or only "sent" with alt-text would have been better

A reply to a reply not shown in RAT (solved)
2 direct replies — Read more / Contribute
by choroba
on Feb 11, 2020 at 03:53
Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (3)
As of 2020-02-17 03:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What numbers are you going to focus on primarily in 2020?










    Results (70 votes). Check out past polls.

    Notices?