Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Seekers of Perl Wisdom

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

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask. Post a new question!

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions
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
    Hello,

    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)

Perl code doesn't echo form data
5 direct replies — Read more / Contribute
by nrabus
on Mar 23, 2020 at 20:55

    I am in a Net-Centric computing course. We have a lab assignment to ask a user to enter data into a form and the Perl code should echo the data back. The HTML is not set up to validate data, so hitting submit without entering data will not trigger a validation message. My code causes the Perl code to be shown in the browser I tried running the html on 3 browsers. The data didn't echo with any of the 3 browsers.instead of echoing the form data. I entered my HTML and Perl programs below: The instructor gave me feedback and said to keep the "T" flag in the first line of my Perl code. Why does it show code instead of the form data? Thank you.

    <!doctype html> <head> <meta charset="utf-8"> <title>index.html</title> <style type = "text/css"> body {background-color: lightblue;} div.background { background-image: url(images/10 pins.jpg); background-position: 100% center; background-origin: border-box; background-repeat: repeat; } .dropbtn { background-color: #4CAF50; color: white; padding: 16px; font-size: 16px; border: none; cursor: pointer; } /* The container <div> - needed to position the dropdown content */ .dropdown { position: relative; display: inline-block; } /* Dropdown Content (Hidden by Default) */ .dropdown-content { display: none; position: absolute; background-color: #f9f9f9; min-width: 160px; box-shadow: 0px 8px 16px 0px rgba(0,0,0,0.2); z-index: 1; } /* Links inside the dropdown */ .dropdown-content a { color: black; padding: 12px 16px; text-decoration: none; display: block; } /* Change color of dropdown links on hover */ .dropdown-content a:hover {background-color: #f1f1f1} /* Show the dropdown menu on hover */ .dropdown:hover .dropdown-content { display: block; } /* Change the background color of the dropdown button when the dropdow +n content is shown */ .dropdown:hover .dropbtn { background-color: #3e8e41; } </style> <meta name = "keywords" content = "bowling, club, central Illinois +"> <link href="styles/style.css" rel="stylesheet" type="text/css"> <!--The following script tag downloads a font from the Adobe Edge Web +Fonts server for use within the web page. We recommend that you do no +t modify it.--><script>var __adobewebfontsappname__="dreamweaver"</sc +ript><script src="http://use.edgefonts.net/adamina:n4:default.js" typ +e="text/javascript"></script> </head> <body> <div class ="background"> <header id="header"><h1>Central Illinois Bowling Club</h1></header +> <p><a href = "standings.html">Last Year's Standings</a></p><br +> <div style="background-color:lightgreen"><img src="images/ +bowling lane.png" width="293" height="187" alt="Bowling Lane"/> <img src="images/team.png" width="273" height="181" alt="T +eam"/> <img src="images/scoresheet.jpg" width="273" height="181" +alt="Scoresheet"/></div><br> <p> Welcome to the Central Illinois bowling Club site. We meet the thi +rd Saturday of the month from September through March. We decide on a + restaurant for dinner, the meet at a bowling alley. There are four b +owling centers we use and use the centers on a rotating basis. We wel +come persons of all ages who want to: <ul id="objectives"><li>A group who wants to build relationships</ +li> <li>A fellowship of those who like bowling or want to learn a +bout the sport</li> <li>Engage in a healthy hobby</li> </ul> Provide your name and phone number if you are interested. The coordina +tor (me) will contact you soon.<br><br> <FORM ACTION="cgi-bin/sample_register.cgi" METHOD="POST"> First name: <input type="text" name="fname"> Last name: <input type="text" name="lname"><br> <input type="radio" id="male" name="gender" value="male"> <label for="male">Male</label> <input type="radio" id="female" name="gender" value="female"> <label for="female">Female</label><br> <label for="age">Age (between 15 and 70):</label> <input type="number" id="age" name="age" min="15" max="70"><br> <label for="Skill">Select skill level:</label> <select id = "Skill"> <option value="Beginner">Beginner</option> <option value="Occasional">Occasional Bowler</option> <option value="Regular">Regular Bowler</option> <option value="HighAvg">High Average Bowler</option> </select><br> <p> Select other sports you participate in:<br> <input type="checkbox" name="sport" value="Baseball"> Baseball<br> <input type="checkbox" name="sport" value="Tennis"> Tennis<br> <input type="checkbox" name="sport" value="Golf"> Golf<br> <input type="checkbox" name="sport" value="Running"> Running<br> <input type="checkbox" name="sport" value="Football"> Football<br> +</p> <input type="submit" value="Submit"> <input type="reset" value="Reset"> </form> </div> </body></html>
    #!/usr/bin/perl -wT use strict; use CGI; my $obj = new CGI; my $datastring =""; # read information from form my $fname = $obj->param( "fname" ); my $lname = $obj->param( "lname" ); my $gender = $obj->param( "gender" ); my $age = $obj->param( "age" ); my $Skill = $obj->param( "Skill" ); my $sport2 = ""; foreach my $sport (@sport) { $sport2 .= "$sport "; } # Save the data into a text file $datastring = "Saved Data\n\nFirst name: $fname\nLast name: $lname\nGe +nder: $gender\nAge: $age\nSkill: $Skill\nSports: $sport2\n\n"; open(OUTDATA, ">>", "data.txt") or die "Error in opening file data.txt +"; print OUTDATA $datastring; close(OUTDATA); #Send the info back print $obj->header( "text/html" ), $obj->start_html( -title => "Form Data", -topmargin =>"0" ), $obj->h1("User information"), $obj->p("User name: $fname"), $obj->p("Last name: $lname"); $obj->p("Gender: $gender"), $obj->p("Age: $age"), $obj->p("Skil: $skill"), $obj->p("Sports: $sport2"), $obj->end_html;
getting a sequence of numbers and leters
5 direct replies — Read more / Contribute
by shabird
on Mar 23, 2020 at 13:36

    I have a file in which i have the following line

    BOGUS PPI3_SYNY3 276 aa linear BCT 13-NOV-2019

    I want to extract BOGUS PPI3_SYNY3 and "276 aa" using regular expression. my code is as follows

    $content =~ /BOGUS\s+([A-Z0-9_]+)/; $bogus = $1; $noOfAcids =~ /\s+([0-9\sa-z]$)/; $acids = $1 ; print("bogus: $bogus\nNumber of acids:$acids\n

    but unfortunately both regex gives the same output.

    OUTPUT

    bogus: PPI3_SYNY3

    Number of amino acids:PPI3_SYNY3

CC with sendmail?
6 direct replies — Read more / Contribute
by htmanning
on Mar 22, 2020 at 20:43
    Monks, I'm trying to send via Cc with sendmail. The first recipient receives the email and the headers look correct with a CC, but the email never makes it to the copied address.
    open (MAIL, "|$sendmail $recipient") || die "Can't open $mailprog!\n" +; print MAIL "From: Return Address <$return_email>\n"; print MAIL "Reply-to: $return\n"; print MAIL "To: $recipient\n"; if ($email2) { print MAIL "Cc: $email2\n"; } print MAIL "Subject: Test!\n\n";
    Is this even possible?
Windows / Linux puzzler
3 direct replies — Read more / Contribute
by lbrandewie
on Mar 22, 2020 at 19:43

    Hey Monks,

    I've got a puzzler. I moved an app from Windows to Linux (CentOS 8 to be specific) to solve library problems. I've got a section of code that tries to determine if an email should be sent. The code looks like this:

    if ($out eq "D") { # not responding to pings if ($lastmailed{"$email|$targ"} <= ($min - $squelch)) { $mailer = psMailer->new(); $mailer->to($email); $mailer->from($emailfrom); $mailer->subject($emailsubject); $mailer->body("Asset $targ is not responding to pings."); $mailer->assetname($targ); $mailer->send(); } }

    psMailer is a simple sendmail interface. That's not the problem. The $min var is calculated as int(time() / 60), so it should always be an int. The $squelch value comes from a settings file. If it is set to 10, the intent is that 10 minutes should pass between emails on a given topic.

    This works in Windows, but in Linux the consistent result is that eleven minutes pass between the emails.

    I don't get it. Do you have any ideas? TIA,

    Lars

    p.s. The perl version on CentOS 8 is 5.26.3. The version I was running in Windows was 5.28.1 (Activestate). I'm on Windows 7 x64.

can't open file for writing that doesn't exist
1 direct reply — Read more / Contribute
by navalned
on Mar 22, 2020 at 15:14

    I've written a dkim-signing filter for opensmtpd that works well. I decided to add the ability to create key pairs and print out the dns entries, etc, etc. Anyway the following code works. Albeit needs some cleaning up. However, it only works if the files already exist.

    sub create_keys { my @selectors; my @towrite; eval { require Crypt::OpenSSL::RSA; require Crypt::OpenSSL::Random; foreach my $domain (keys %keys) { my $keyfile = $keys{$domain}->{key}; my $pubfile = $keyfile =~ s/key/pub/g; my $selector = $keys{$domain}->{selector}; Crypt::OpenSSL::RSA->import_random_seed(); my $rsa = Crypt::OpenSSL::RSA->generate_key(1024); my $pub_string = $rsa->get_public_key_string(); my $key_string = $rsa->get_private_key_string(); my $select_string = "-----BEGIN DNS ENTRIES FOR $domain--- +--\n"; $select_string .= "_domainkey IN TXT \"o=~;\"\n\n"; $pub_string =~ s/-----BEGIN\ RSA\ PUBLIC\ KEY-----//g; $pub_string =~ s/-----END\ RSA\ PUBLIC\ KEY-----//g; $pub_string =~ s/\s//g; $select_string .= "$selector\._domainkey IN TXT \"k=rsa\\; +\n"; $select_string .= "p=$pub_string\\;\"\n"; $select_string .= "-----END DNS ENTRIES FOR $domain-----\n +"; push @selectors, $select_string; push @towrite, { key => $keyfile, pub => $pubfile, keystring => $key_string, pubstring => $pub_string }; } }; die "Failed to create keypair: $@" if $@; # moved this out of the eval just to see if that would change anything foreach my $write (@towrite) { { open (my $key, ">", $write->{key}) or die "$!"; print $key $write->{keystring}; open (my $pub, ">", $write->{pub}) or die "$!"; print $pub $write->{pubstring}; } } foreach my $s (@selectors) { print $s . "\n"; } exit 0; }

    Here is some sample output:

    -----BEGIN DNS ENTRIES FOR domain.tld----- _domainkey IN TXT "o=~;" dkim._domainkey IN TXT "k=rsa\; p=MIGJAoGBAKghtMMxSlhU973zhV29hc0xeppV76jQmdLoIV/Zz9wJw6OenVU4dFWaT5gz +ENe3ufSxkbSOOmGKl5ukurpvPXtoymoD7DcVkU02HDApzmVgwHpT4E/A22SoGxuNwqFrh +VTmwb4gdSVGOKnkUIgeXelDsoG2F22FgnxWjjH03u/FAgMBAAE=\;" -----END DNS ENTRIES FOR domain.tld----- -----BEGIN DNS ENTRIES FOR domain.stuff.tld----- _domainkey IN TXT "o=~;" dkim._domainkey IN TXT "k=rsa\; p=MIGJAoGBAMAxZ3sixzpuON9XQu+zVzJknyJ6sQcJGZxpHKDTz2QG7V5Hpno3jXHYrHqf +nJ+pDtw7IloAT6zYe4DAsFyTbj1/96r1eRubL8DnU59mtxQAQmyoOVa0hiyJss6RTq49Z +dXuVhF0bqqvgrBS51ErkddACBz5F2TxfkO/qli6boL3AgMBAAE=\;" -----END DNS ENTRIES FOR domain.stuff.tld-----

    This is what I get if the files don't already exist:
    Error: cannot read /home/edgar/domain.stuff.tld.key: No such file or directory

    This of course works:
    perl -e 'open (my $fh, ">", "/home/edgar/domain.test.key") or die "$!";'
    And creates a 0 length file.

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.


Add your question
Title:
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • 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 chilling in the Monastery: (5)
    As of 2020-04-01 05:44 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      To "Disagree to disagree" means to:









      Results (186 votes). Check out past polls.

      Notices?