Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
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
Array of buttons
3 direct replies — Read more / Contribute
by GayathriBalu
on Oct 22, 2014 at 07:41

    hi all, i want to create an array of buttons and handle them when clicked. in my code the last button in the array is handled even if any other button is clicked. pls help. thanks

    my @buttons; for my $i(0..5){ push @buttons, $mw->Button(-text => $i, -command => sub{ print "pressed $i\n"; # or use the widget: print "pressed ", $buttons[$i]->cget('-text'), "\n"; })->pack; }
direct data to a socket
2 direct replies — Read more / Contribute
by demoralizer
on Oct 22, 2014 at 04:14
    Hi there,

    looking at CPAN module IO:All I found some syntax I don't understand, maybe sb. here can help me with that:
    perl -MIO::All -e 'io(":8080")->fork->accept->(sub { $_[0] < io(-x $1 ? "./$1 |" : $1) if /^GET \/(.*) / })'

    What's driving me crazy is the "<" after $_[0].

    If I dump $_[0] I get: bless( \*Symbol::GEN3, 'IO::All::Socket' );

    I've been searching through the Internet and perldoc but couldn't find any description what this "<" is doing exactly :(

    Thanks a lot for any help (even any keywords to search for will be highly welcomed)
Log Write position
5 direct replies — Read more / Contribute
by pgduke65
on Oct 22, 2014 at 01:13

    Hi Monks,

    I am wanting to write a program that creates a log entry for a process start and end. What I would like is to have 1 entry per process per execution.

    As an example:

    Logged Job Start End

    10/22/14 13:00:00 J1 10/22/14 13:00:00 10/22/14 13:05:00

    10/23/14 13:00:00 J1 10/23/14 13:00:00 10/23/14 13:05:00

    The question, I have is, If I write the start time at process start, how can I write the end time to the entry? Another process can write to the for its start. As a result, I can't just assume last entry in the file

    Any advice is appreciated.

DBI mysql substring_index syntax error
2 direct replies — Read more / Contribute
by Rodster001
on Oct 22, 2014 at 00:08
    This statement works fine from the mysql prompt:
      SELECT DISTINCT SUBSTRING_INDEX(SUBSTRING_INDEX(path, "\\", -2), "\\", 1) AS dir FROM files
    
    But I get a "DBD::mysql::st execute failed" error when I run this:
    my $query = qq~ SELECT DISTINCT SUBSTRING_INDEX(SUBSTRING_INDEX(path, "\\", -2), "\\ +", 1) AS dir FROM files ~; my $sth = $dbh->prepare($query); my $rv = $sth->execute;
    DBD::mysql::st execute failed: You have an error in your SQL syntax; check the manual that corresponds to your MySQL server version for the right syntax to use near '\", 1) AS dir

    So, I believe that something is not escaped properly in my statement and I have tried several different ways but no luck.

    Any ideas?
Regular Expressions in a cookie
3 direct replies — Read more / Contribute
by rshoe
on Oct 21, 2014 at 19:05
    I do not know if this is possible but I am trying to create a form that sends information to a cgi file. That file creates a cookie. Then I have another cgi file that displays the information of the cookie. Most of the files work except the last one. I'm trying to use an if statement to tell if a certain radio button is used then print the information one way if not print the information another way. I'm using a regular expression in the if statement. The last file "membership.cgi" does not work correctly. If any one can help me I would appreciate it. Thank you for your time. Randy Here are my files: html file:
    <!doctype html> <html lang = "en"> <head> <title>Sign Up</title> </head> <body> <h2>Sign up and choose your options</h2> <form action="/cgi-bin/signup.cgi" method="post"> <table border="2" cellspacing="5" cellpadding="5"> <tr> <td align="center">Name</td> <td><input type="text" name="name" size="30"></td> </tr> <tr> <td align="center">Select MemberShip Type</td> <td><input type = "radio" name = "membership" value="0">Life <input type = "radio" name = "membership" value="1">Annual <input type = "radio" name = "membership" value="2">Fee Trial</td> </tr> <tr> <td align="center">Choose Background Color</td> <td><select name = "color"> <option value = "pk">Pink <option value ="cy">Cyan <option value = "ma">Magenta <option value ="wh">White <option value = "go">Gold <option value ="bl">Blue </select> </tr> <tr> <td colspan="2" align="center"><input type = "submit" value="Sign Up + and Set Options" </td> </tr> </form> </table> </body> </html>
    The cookie cgi file
    #!c:\Dwimperl\perl\bin\perl.exe use CGI qw(:standard); use CGI::Carp qw(fatalsToBrowser); use strict; use warnings; my $name = param('name'); my $membership = param('membership'); my $color = param('color'); my @members = ('Life', 'Annual', 'Free Trial'); my %colors =(pk => 'Pink', cy => 'Cyan', ma => 'Magenta', wh => 'White', go => 'Gold', bl => 'Blue',); my @newmembers =($members[$membership], $name, $colors{$color}); my $mem = cookie(-name => "member", -value => "@newmembers", -path => "/", -expires => "+1M" ); print header( -cookie => [$mem] ), start_html, "<h2>Thank you. Your data has been recorded</h2>", "<a href='membership.cgi'>See member page</a>", end_html;
    The output cgi file
    #!c:\Dwimperl\perl\bin\perl.exe use CGI qw(:standard); use CGI::Carp qw(fatalsToBrowser); use strict; use warnings; my @ara = split (/ /,cookie("member")); #### splits on spaces into ar +ray if($ara[0] =~ /Free Trial/){ print header, start_html; print "<body bgcolor ='".$ara[4]."'/>"; print "<h1>Welcome back, ".$ara[0]." ".$ara[1]." Member ".$ara[2]." ". +$ara[3]."</h1>"; print end_html; }else{ print header, start_html; print "<body bgcolor ='".$ara[3]."'/>"; print "<h1>Welcome back, ".$ara[0]." Member ".$ara[1]." ".$ara[2]."</h +1>"; print end_html; }
Reset the time after a readdir
3 direct replies — Read more / Contribute
by Anonymous Monk
on Oct 21, 2014 at 18:39

    I am reading a directory for files and if the files are newer than say X then I would like to copy them. The issue I am having is that I cannot reset the time when the while loop reads the directory again. So if the file is newer than X the next time through the loop it reads the same time so that action is constantly repeated. I am hoping on each loop through that the time of how old the files will be updated by the value of X. So if my if statement becomes untrue the action will stop

    Here is my code
    ##! /usr/local/bin/perl use strict; use warnings; use File::Copy; my $sleep = 10; my $dirname = "Directory A"; my $dirname2 = "Directory B"; my $filterstring = "\\.jpg\$"; while (1) { opendir ( DIR, $dirname ) || die "Error in opening dir $dirname\n"; foreach my $file (readdir (DIR)) { next if not $file =~ m/$filterstring/; $file = $dirname.'/'.$file; print "found $file, mtime: ".(-M $file)."\n"; if (-f $file && (0.0005 > -M $file)){ my $capture = $dirname . $file; my $qc = $dirname2; print "Copying $file to $qc\n"; copy($file, $qc); reset; } } reset ; closedir (DIR); sleep $sleep; 1; }
Spreadsheet::WriteExcel, numbers with comma's?
1 direct reply — Read more / Contribute
by jamesgerard1964
on Oct 21, 2014 at 16:26
    Hey, I'm trying to printout to an xlsx sheet, so being large numbers where I'd like to comma separate the numbers. I can't do it via sprintf, but have gotten the variable to insert a comma using:
    $ffcount = reverse join ",", (reverse $ffcount) =~ /(\d{1,3}) +/g;

    However now when I do the $worksheet->write it comes out as a string as opposed to a number and it's left justified. I need it right justified.

    The other question is there is a triangle in the upper left corner of each entry in the column for non-number entries. If I click on it another box appears where I can select 'Number Stored as Text', 'Convert to Number'. Does anyone know how to get rid of that. I don't have a problem storing it as a string, but right justified and without the triangle.

Reliable glob?
2 direct replies — Read more / Contribute
by hepcat72
on Oct 21, 2014 at 14:34

    I became disenchanted with perl's glob function quite some time ago and started using bsd_glob instead. It seems to be able to handle the strings it's given a lot better and more comprehensively, but I encountered some unexpected results yesterday. I implemented a work-around, but I'd like the implementation to be more simple.

    I debugged an issue where, when the script was called and given a long glob pattern, it was truncating it to just the preceding directory. So I just wrote a preprocessing routine to pre-expand any patterns containing '{...}' to hopefully shorten the string sent in on the command line before calling bsd_glob on it.

    As far as I understand this issue - and I could be slightly off - the posix flag GLOB_LIMIT (or *ARG_MAX?) is set too low to be able to handle a string that was successfully submitted to the script.

    By implementing my preprocessing of the string that comes from the command line, I was able to break anything up that had a '{...}' pattern in it into shorter pieces that I then spoon-feed to bsd_glob a bite at a time.

    I feel like there's got to be a better solution. If the script is receiving the whole string from the command line, shouldn't the limits of bsd_glob be the same as the surround shell - why would it not be able to handle as long of a string as the surrounding shell script can give it?

    Here's a toy example which shows it not work in the first call, but remove 1 bit and it does work in the second call:

    >perl -e '$x="cff_updated/1_lib/{A3DWE.1.Solexa-142587.splice.fastq,A3 +DWE.1.Solexa-142588.splice.fastq,A3DWE.1.Solexa-142589.splice.fastq,A +3DWE.1.Solexa-142590.splice.fastq,A3DWE.1.Solexa-142594.splice.fastq, +A3DWE.1.Solexa-142595.splice.fastq,A3DWE.1.Solexa-142596.splice.fastq +,A3DWE.1.Solexa-142597.splice.fastq,A3DWE.1.Solexa-142598.splice.fast +q,A3DWE.1.Solexa-142599.splice.fastq,A3DWE.1.Solexa-142600.splice.fas +tq,A3DWE.1.Solexa-142602.splice.fastq,A3DWE.1.Solexa-142603.splice.fa +stq,A3DWE.1.Solexa-142605.splice.fastq,A3DWE.1.Solexa-142606.splice.f +astq,A3DWE.1.Solexa-142607.splice.fastq,A3DWE.1.Solexa-142608.splice. +fastq,A3DWE.1.Solexa-142609.splice.fastq,A3DWE.1.Solexa-142610.splice +.fastq,A3DWE.1.Solexa-142611.splice.fastq,A3DWE.1.Solexa-142612.splic +e.fastq,A3DWE.1.Solexa-142613.splice.fastq,A3DWE.1.Solexa-142614.spli +ce.fastq,A3DWE.1.Solexa-142615.splice.fastq,A3DWE.1.Solexa-142616.spl +ice.fastq,A3DWE.1.Solexa-142617.splice.fastq,A3DWE.1.Solexa-142618.sp +lice.fastq,A3DWE.1.Solexa-142619.splice.fastq,A3DWE.1.Solexa-142621.s +plice.fastq}.drp.fna.lib";use File::Glob ":glob";@y=bsd_glob($x);prin +t(join("\n",@y),"\n");' cff_updated/1_lib/ >perl -e '$x="cff_updated/1_lib/{A3DWE.1.Solexa-142587.splice.fastq,A3 +DWE.1.Solexa-142588.splice.fastq,A3DWE.1.Solexa-142589.splice.fastq,A +3DWE.1.Solexa-142590.splice.fastq,A3DWE.1.Solexa-142594.splice.fastq, +A3DWE.1.Solexa-142595.splice.fastq,A3DWE.1.Solexa-142596.splice.fastq +,A3DWE.1.Solexa-142597.splice.fastq,A3DWE.1.Solexa-142598.splice.fast +q,A3DWE.1.Solexa-142599.splice.fastq,A3DWE.1.Solexa-142600.splice.fas +tq,A3DWE.1.Solexa-142602.splice.fastq,A3DWE.1.Solexa-142603.splice.fa +stq,A3DWE.1.Solexa-142605.splice.fastq,A3DWE.1.Solexa-142606.splice.f +astq,A3DWE.1.Solexa-142607.splice.fastq,A3DWE.1.Solexa-142608.splice. +fastq,A3DWE.1.Solexa-142609.splice.fastq,A3DWE.1.Solexa-142610.splice +.fastq,A3DWE.1.Solexa-142611.splice.fastq,A3DWE.1.Solexa-142612.splic +e.fastq,A3DWE.1.Solexa-142613.splice.fastq,A3DWE.1.Solexa-142614.spli +ce.fastq,A3DWE.1.Solexa-142615.splice.fastq,A3DWE.1.Solexa-142616.spl +ice.fastq,A3DWE.1.Solexa-142617.splice.fastq,A3DWE.1.Solexa-142618.sp +lice.fastq,A3DWE.1.Solexa-142619.splice.fastq}.drp.fna.lib";use File: +:Glob ":glob";@y=bsd_glob($x);print(join("\n",@y),"\n");' cff_updated/1_lib/A3DWE.1.Solexa-142587.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142588.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142589.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142590.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142594.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142595.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142596.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142597.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142598.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142599.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142600.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142602.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142603.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142605.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142606.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142607.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142608.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142609.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142610.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142611.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142612.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142613.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142614.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142615.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142616.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142617.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142618.splice.fastq.drp.fna.lib cff_updated/1_lib/A3DWE.1.Solexa-142619.splice.fastq.drp.fna.lib

    Perhaps bsd_glob is behaving as it should and the design of my surrounding script is what needs to be fixed...

    The surrounding shell script is part of a distributed package - a pipeline of analysis commands, each of which is a perl script. I had decided to handle the input files explicitly instead of supplying a glob pattern involving an '*' so that users could analyze a subset of their data files. Each step in the pipeline adds an extension to each of the files, which is why I chose to use the '{...}' glob pattern, so that I could do this: -d "{$STUBS}.extension". I wrapped it in double quotes so that the shell wouldn't expand them into a space-separated list and thus everything would be identified as an argument to the preceding flag. Like this:

    script.pl -i "dir1/{$STUBS}.drp.fna.lib.n0s.cands" -d "dir2/{$STUBS}.drp.fna.lib"

    Assuming that I might eventually encounter a command that exceeds an arbitrary command-line length limit, what would be a better way to submit a series of files, each with an added extension from the output of the previous step?

    I await the wisdom of the perl monks.

Perl and jQuery to select mutiple elements from dropdown by checking checkboxes
3 direct replies — Read more / Contribute
by ashraot
on Oct 21, 2014 at 13:13
    I have a multiselect dropdown which has 8 colors in a hash %all_colors:
    my %all_colors = ( 1 => 'Red', 2 => 'Yellow', 3 => 'Orange', 4 => 'Blue', 5 => 'Black', 6 => 'Brown', 7 => 'Green', 8 => 'White', );
    I have put it in a dropdown like this:
    my $color_selector = '<select name="all_colors">'; foreach my $color (sort {$all_colors{$a} cmp $all_colors {$b}} key +s %all_colors ) { $color_selector .= qq~<option value="$color">$all_colors{$colo +r}</option>~; } $color_selector .= '</select>'; <div><% $color_selector %></div>
    Now I want to add 2 new checkboxes.
    <div> <input type="checkbox" name="maincolors" value="1" class="inpu +tCheckbox" /> Main Colors <input type="checkbox" name="resetofcolors" value="1" class="i +nputCheckbox" /> Rest of the Colors </div>
    And in Perl, I added one more constant to select checkbox1 and use constant in perl to call the checkbox. I dont know how to use this to select these 4 values in dropdown when "Main Colors" checkbox is checked. And Rest of colors should be checked when clicked on "Rest of the Colors" checkbox.
    use constant MAIN_COLORS => { 1 => 'Red', 2 => 'Orange', 3 => 'Green', 4 => 'White', }; my $main_colors = MAIN_COLORS;
    I have written a code which uses plain HTML but I actually want to call the colors from Perl hash
    <select id="multipeColorSelect" multiple size="8"> <option value="Red" class="maincolor">Red</option> <option value="Orange" class="maincolor">Orange</option> <option value="Green" class="maincolor">Green</option> <option value="White" class="maincolor">White</option> <option value="Yellow">Yellow</option> <option value="Blue">Blue</option> <option value="Black">Black</option> <option value="Brown">Brown</option> </select>
    But I dont want this to use plain HTML, instead I want : 1) If I select checkbox1 "Main Colors", it should automatically select Red, Orange, Green, White from the dropdown ie., it should call values from hash 2) If I select checkbox2 "Rest of the Colors", it should automatically select first 4 from the dropdown ie., it should call values from hash Please help. Also, There are some conditions which is not working in jQuery as expected. I need help for jQuery also. 1) If any 1 color is randomly selected from the dropdown instead of checking checkbox, then I want to disable the checkbox which is not related to that group. Ex: If Red is selected from dropdown directly, "Rest of the Colors" checkbox should be disabled. If I deselect Red and select Brown directly, then "Rest of the colors" checkbox should be reenabled and "Main Colors" checkbox should be disabled. 2) One set of four elements need not be disabled when others are selected. Both can be selected simutlaneously so that all are selected by checking both checkboxes. Users are allowed to select and deselect members of the group of four which is already working in jQuery code below. 3) If "White" and "Yellow" both are selected at the same time from dropdown, then both checkboxes should be enabled.
    $('input[name="colorcheckbox"]').click(function () { var colorsToSelect = $(this).val(); if($(this).prop('checked') == true) { if(colorsToSelect == 'maincolors') { $('#multipeColorSelect option').slice(0,4).prop('selected' +, true); } else if (colorsToSelect == 'restofcolors') { $('#multipeColorSelect option').slice(4,8).prop('selected' +, true); } } else { if(colorsToSelect == 'maincolors') { $('#multipeColorSelect option').slice(0,4).prop('selected' +, false); } else if (colorsToSelect == 'restofcolors') { $('#multipeColorSelect option').slice(4,8).prop('selected' +, false); } } });
    Please help.
Forking Perl5 with Microperl++?
2 direct replies — Read more / Contribute
by rje
on Oct 21, 2014 at 10:27

    "If I were to implement a language now, I'd write a very minimal core suitable for bootstrapping. ... Think of a handful of ops. Think very low level. (Think something a little higher than the universal Turing machine and the lambda calculus and maybe a little bit more VMmy than a good Forth implementation, and you have it.) If you've come up with something that can replace XS, stop. You're there. Do not continue. That's what you need." (Chromatic, January 2013)

    This is in Chromatic's response to Moe, which sounds -Ofun and seems like a good idea.

    And now that I've crawled out from under my rock, I see microperl, an ancient tool included with 5.8. Alright, I don't recall ever hearing about microperl. It's not in my copy of the Programming Perl book, and that sucker is a thousand pages.

    And lately, haven't I seen grumblings about the insularity and stubborn bikeshedding nature of the Perl community?

    So how about this. Microperl isn't the "handful of ops" that Chromatic is suggesting, and it ain't XS, but it's tiny and, well, it's Perl. Therefore, what are the issues around forking and modifying microperl (oh so gently) to bootstrap a variant of Perl5? I mean, it's already written, and it's tiny -- minimal, if Simon is to be believed. I mean, the thing built in a 300k footprint when compiled with a proper optimizer. So what's not to like?

    So I re-ask my question. Doesn't microperl seem to be at least halfway to a bootstrap up to a useful and somewhat regularized, normalized, unpackable, what-have-you-able variant of Perl5?

    Just for reference, here's a sample microperl script written in zentara's discussion. It seems pretty handily powerful for being a tiny subset of perl. Is there documentation for microperl?


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!
  • 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
  • Outside of code tags, you may need to use entities for some characters:
            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 lurking in the Monastery: (3)
    As of 2014-10-25 04:44 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      For retirement, I am banking on:










      Results (141 votes), past polls