Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

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
Checking JSON decoded params from Dancer
2 direct replies — Read more / Contribute
by PerlSufi
on Jul 11, 2014 at 12:49
    Hello Monks,
    I have an issue where I am trying to check JSON decoded data from Dancer params. My module has something like this:
    use strict; use warnings; use Dancer; use JSON qw(decode_json); my $foo_info = param('foo_info'); if ( !eval { decode_json($foo_info); 1 } ) { flash error => "Failed" } if ( !exists $foo_info->{foo_total} || !($foo_info->{foo_total} =~ m/^\$\d+\.\d{2}$/)) { error("Invalid or missing foo info"); return 0; }
    And the errors that I am getting are:
    Error decoding json data: malformed JSON string, neither tag, array, object, number, string or +atom, at character offset 0 (at the line I'm decoding the json) request to POST /path/to/site crashed: Can't use string .. (json data +spit out here) as a HASH ref
    So my problem may be 2 fold, but I do know I need help checking the values in the JSON 'foo_info' ..Any insight is greatly appreciated :)
Dumping input variables inTemplate::Toolkit templates
1 direct reply — Read more / Contribute
by Anonymous Monk
on Jul 11, 2014 at 12:12
    I'm trying to write in the bottom part of any HTML page that I generate with Template::Toolkit a summary of the parameters that were passed to the template.
    If I know that I'm passing a hash named some_hash, I can dump it with:

    ... <!-- some_hash: [% USE Dumper; GET Dumper.dump( some_hash ); %] --> </body> </html>
    Since I want to have this dump into a template that I'm including in all other templates, is there a way I can generalize this to all the variables that are passed to each page? I don't understand how can I get a list of variables passed to the template.

    Thank you
Comparing array of aligned sequences
2 direct replies — Read more / Contribute
by newtoperlprog
on Jul 11, 2014 at 12:06

    Dear all, I am new to perl and trying to learn the various concepts related to the language. I am trying to parse a aligned dna sequences and printing when each position the alphabets are same. If there is a mismatch then it should skip that and print the next consnsus sequence in new line. Here I am posting the code and sample file. Any help will be greatly appreciated. Thank you all

    #!/usr/bin/perl use warnings; use strict; my $seqcount; my $pos; my $arrlen; my @arr = (); open (B, "temp.dat"); while (my $line=<B>) { chomp $line; $seqcount++; $line =~ s/\s//g; my @temp = split (//, $line); $arrlen = scalar(@temp); for ($pos=0;$pos<=scalar(@temp);$pos++) { $arr[$seqcount][$pos] = $temp[$pos]; } } my $max_position = 0; $max_position = $arrlen if($arrlen > $max_position); for ($pos=0;$pos<=$max_position;$pos++) { for (my $s=1;$s<=$seqcount;$s++) { if ($arr[$s][$pos] ne $arr[$seqcount][$pos]) { print "\n"; next; } else { print "$arr[$s][$pos]"; } } }
    temp.dat atggctgctaggctgtgctgccaactggatcctgcgcgggacgtcctttgtctacgtcccgtcggcgctg +aatcctgcggacgacccctctcgtggtcgcttggggctctgccgccctcttctccgcctgccgttccgg +c atagctgctaggctgtgctgccaactggatcctgcgcgggacgtcctttgtctacgtcccgtcggcgctg +aatcctgcggacgacccctctcgtggtcgtttggggctctgccgccctcttctccgcctgccgttcagg +c atggctgctaggctgtgctgccaactggatcctgcgcgggacgtcctttgtctacgtcccgtcggcgctg +aatcctgcggacgacccctctcgtggtcgcttggggctctgccgccctcttctccgcctgccgttccgg +c atggctgctaggctgtgctgccaactggatcctgcgcgggacgtcctttgtctacgtcccgtcggcgctg +aatcctgcggacgacccctctcgtggtcgcttggggctctaccgccctcttctccgcctgccgttccgg +c
    Desired output at gctgctaggctgtgctgccaactggatcctgcgcgggacgtcctttgtctacgtcccgtcggcgctgaat +cctgcggacgacccctctcgtggtcg ttggggctct ccgccctcttctccgcctgccgttc ggc
Reading back up through an array
1 direct reply — Read more / Contribute
by TheStig
on Jul 11, 2014 at 11:14

    The title makes this problem seem much easier than it is. I know what I want to do programmatically but I am still new to Perl and putting what I want to do into Perl code is where I am getting hung up. The following code takes an Excel and PDF version of one file and takes what I need and outputs a CSV file.

    #!/usr/bin/perl -w use warnings; use strict; use PDF::API2; use CAM::PDF; use CAM::PDF::PageText; use String::Util ':all'; use Spreadsheet::ParseXLSX; use Text::CSV; use Date::Format; use DateTime::Format::DateParse; my $pdfFilename = "<insert PDF file name>"; my $pdf = CAM::PDF->new($pdfFilename); my $text = $pdf->getPageText(1); my $endString = "DELIVERY"; my $headIndex = index($text, $endString); my $newText = substr($text, 0, $headIndex); my $header = trim($newText); my $amdNumStart = "NO. "; my $amdNumEnd = "GAS"; my $amdNumStartIndex = index($header, $amdNumStart)+3; my $amdNumEndIndex = index($header, $amdNumEnd); my $amdNumString = substr($header, $amdNumStartIndex, $amdNumEndIndex +- $amdNumStartIndex); my $amdNum = trim($amdNumString); my $poolNumStart = "30202"; my $poolNumEnd = "TIGER"; my $poolNumStartIndex = index($header, $poolNumStart); my $poolNumEndIndex = index($header, $poolNumEnd); my $poolNumString = substr($header, $poolNumStartIndex, $poolNumEndInd +ex - $poolNumStartIndex); my $poolNum = trim($poolNumString); my $dateStart = "DATED "; my $dateStartIndex = index($header, $dateStart)+6; my $dateEndIndex = index($header, $dateStart); my $dateString = substr($header, $dateStartIndex, $dateEndIndex - $dat +eStartIndex); my $reportDate = trim($dateString); my @date = split(' ', $reportDate); my $month = $date[0]; my $day = $date[1]; my $comma = chop($day); my $year = $date[2]; my $dateJoin = join(' ', $month,$day,$year); my $parsedDate = DateTime::Format::DateParse->parse_datetime($dateJoin +); my $billMonth = $parsedDate->strftime('%m%d%Y'); my $fileName = "<insert Excel file name>"; my $parser = Spreadsheet::ParseXLSX->new(); my $workbook = $parser->parse($fileName); my $outfile = "NMGC_Snapshot_$billMonth.csv"; die $parser->error(), ".\n" if (!defined $workbook); open(my $out, '>', $outfile) or die "Could not open $outfile' $!\n"; my $csv = Text::CSV->new(); my @fields = ('Customer Name','Street Address','City','Station Num','C +ustomer Num','Premise Num','Point MDQ','Priority Class','Rate Schedul +e','Consolidated Station Num'); $csv->combine($amdNum, $poolNum, $billMonth,'','','','','','',''); print $out $csv->string, "\n"; $csv->combine(@fields); print $out $csv->string, "\r\n\r\n"; for my $worksheet($workbook->worksheet(0)){ my($firstRow, $lastRow) = $worksheet->row_range(); for my $row(6 .. $lastRow){ #array of cell values my $RowCellValues = []; for (my $col = 1; $col < 10; $col++) { my $cell = $worksheet->get_cell($row, $col); next unless $cell; push($RowCellValues, $cell->value()); } my $status = $csv->print ($out, $RowCellValues); print $out "\r\n"; } }

    Every once in awhile in the file there is a blank line. Once my code hits the blank line it needs to go back up one row and see if it is a consolidated station. If that is true it takes the number from that line and needs to write that number onto the end of every line up to the previous blank line. If the line right above the blank line is not a consolidated station i need to write the station number from each individual account onto the end of each line up to the previous blank line. This first example is a piece of what is currently being output to my CSV file. The first two lines are header lines.

    87,30202,05012014,,,,,,, "Customer Name","Street Address",City,"Station Num","Customer Num","Pr +emise Num","Point MDQ","Priority Class","Rate Schedule","Consolidated + Station Num" "Customer1","123 Main St.",City A,48,801,6,5,2,54 "Customer2","123 Main St.","City S",22,614,79,3,2,54 "Customer3","123 Main St.","City S",23,615,95,4,2,54 "Customer4","123 Main St.","City S",24,616,66,1,2,54 "Customer5","123 Main St.","City S",25,617,14,2,2,54 "Customer6","123 Main St.","City S",26,618,22,2,2,54 "CUSTOMER CONSOLIDATED STATION",,,20,,,, "Customer7","123 Main St.",City A,16,305,16,94,1,54 "Customer8","123 Main St.","City P",28,214,43,1,2,54 "Customer9","123 Main St.","City P",29,215,99,143,2,54 "Customer10","123 Main St.","City P",30,216,39,21,2,54 "Customer Consolidated Station",31 "Customer11","123 Main St.",City A,70,902,25,7,2,54 "Customer12","123 Main St.",City A,71,903,72,6,2,54

    Here is what I am needing the final output to be. You will see the consolidated station numbers added to the end of each customer record.

    87,30202,05012014,,,,,,, "Customer Name","Street Address",City,"Station Num","Customer Num","Pr +emise Num","Point MDQ","Priority Class","Rate Schedule","Consolidated + Station Num" "Customer1","123 Main St.",City A,48,801,6,5,2,54,48 "Customer2","123 Main St.","City S",22,614,79,3,2,54,20 "Customer3","123 Main St.","City S",23,615,95,4,2,54,20 "Customer4","123 Main St.","City S",24,616,66,1,2,54,20 "Customer5","123 Main St.","City S",25,617,14,2,2,54,20 "Customer6","123 Main St.","City S",26,618,22,2,2,54,20 "CUSTOMER CONSOLIDATED STATION",,,20,,,, "Customer7","123 Main St.",City A,16,305,16,94,1,54,16 "Customer8","123 Main St.","City P",28,214,43,1,2,54,31 "Customer9","123 Main St.","City P",29,215,99,143,2,54,31 "Customer10","123 Main St.","City P",30,216,39,21,2,54,31 "Customer Consolidated Station",31 "Customer11","123 Main St.",City A,70,902,25,7,2,54,70 "Customer12","123 Main St.",City A,71,903,72,6,2,54,71

    I have a feeling i need to read back up the array that is helping to write the CSV every time i hit a blank line, but I am not sure how to do this. Also if anyone has a better idea that would be very helpful.

Spreadsheet::XLSX date format problem
3 direct replies — Read more / Contribute
by Anonymous Monk
on Jul 11, 2014 at 10:21
    Hi there Monks!

    I am using Spreadsheet::XLSX module to read the data from a .xlsx(spreadsheet) file.

    Source file value : 10/23/2013
    The actual data once parsed : 41570 ( The values returned from the cell while reading the data from that cell).

    It seems to be the number of days since 12/30/1899? Is this a bug with the module?
    Is there a way to solve this issue like converting or parsing 41570 days since 12/30/1899 to get 10/23/2013 after I read the date data from the .xlsx file?
    Here is the code I am using:

    sub xlsx_get { my $file_to_parse = shift; my @values; my $excel = Spreadsheet::XLSX -> new ($file_to_parse) or die "could + not read the excel: $@$!"; foreach my $sheet (@{$excel -> {Worksheet}}) { $sheet -> {MaxRow} ||= $sheet -> {MinRow}; # Skip worksheet if it doesn't contain data. next if $sheet -> {MinRow} > $sheet -> {MaxRow}; my $c=0; foreach my $row ($sheet -> {MinRow} .. $sheet -> {MaxRow}) { $c++; $sheet -> {MaxCol} ||= $sheet -> {MinCol}; my $name_xlsx = $sheet->{Cells}[$row][0]->{Val}; my $date_xlsx = $sheet->{Cells}[$row][1]->{Val}; # Skip if it doesn't contain data. next unless $name_xlsx; # log for test date format warn $date_xlsx; push @values, [ $name_xlsx, $date_xlsx ]; } } return \@values; } # end sub xlsx_get

    Thanks for looking!
Append new line in excel sheets
3 direct replies — Read more / Contribute
by perl_new_b
on Jul 11, 2014 at 08:54

    Hi, I want to insert(append) a new row at the end of excel file which contains multiple worksheets. I can't use Win32::OLE as the machine on which I'm working doesn't have MS Office. Kindly suggest me some way around...

local packages in windows
2 direct replies — Read more / Contribute
by Arthfael
on Jul 11, 2014 at 06:55
    Hi, I am a complete Perl noob and my experience of scripting is limited to some R data analysis. My cmd-line-fu is virtually non-existent. I have been trying to run a perl program I downloaded for proteomics analysis, however it requires that I install two non-CPAN packages (included in the download). My laptop runs Windows 8.1, and the Perl distribution I have installed is DwimPerl. My problem is that I have been unable to install the two required packages from my local hard drive. I have the .pm files, and I have created .tar.gz files from them. I have been able to create a local repository which contains a package folder with homemade .PPD files where the HREF address points to an x86 subfolder which contains the .tar.gz files. However, the packages are not detected by PPM. Is there something I am missing?
How do i color font in a listbox?
3 direct replies — Read more / Contribute
by james28909
on Jul 11, 2014 at 00:02
    i have successfully figured out how to append strings to a listbox from a variable, now the problem is formatting the text. i can change the font size, face, ect but i cannot figure out how to color the text green or red, is there a package i am missing?

    Here is the code, and i just want the if statement to color green if true and red if false.
    use File::Slurp; use Digest::MD5; use Wx; use Wx qw(:everything); use Wx::Event qw(EVT_DROP_FILES); use Wx::DND qw(FileDropTarget); ###################################################################### +######## my $app = Wx::SimpleApp->new; my $frame = Wx::Frame->new( undef, -1, 'test tool', [150,600], Wx::Size->new(700,400), wxDEFAULT_DIALOG_STYLE|wxSTAY_ON_TOP ); ###################################################################### +######### tool($frame); sub tool { my ($self) = @_; $frame->DragAcceptFiles(1); EVT_DROP_FILES( $frame, \&ondrop ); sub ondrop { my ($self, $this) = @_; $lb->Clear(); Wx::DropFilesEvent::GetFiles($this); our $dropfile = $this->GetFiles(); \&file($dropfile); } my $noteBook = Wx::Notebook->new($frame, -1, wxDefaultPosition, wx +DefaultSize); my $window1 = Wx::Panel->new($noteBook, wxID_ANY); my $window2 = Wx::Panel->new($noteBook, wxID_ANY); my $window3 = Wx::Panel->new($noteBook, wxID_ANY); $noteBook->AddPage($window1, "First", 1, 0); $noteBook->AddPage($window2, "Second", 0, 1); $noteBook->AddPage($window3, "Third", 0, 2); our $lb = $window1->{my_listbox} = Wx::ListBox->new($window1, wxID_ANY, [350 , 10] +, Wx::Size-> +new(300,330 )); sub file { my $dirname = "extracted/"; my @md5s = read_file("md5"); my $md5s = join( '', @md5s ); my $filesize = ''; open( my $buf1, '<', "extracted/sdk_version" ) or die "cannot open sdk +_version: $!"; seek( $buf1, 0x00, 0 ); read( $buf1, my $sdk, 0x03 ); foreach my $file (<$dirname/*>) { next if -d $file; open( my $FILE, $file ); binmode($FILE); $filesize = -s $FILE; $file =~ s{.*/}{}; $md5 = Digest::MD5->new->addfile($FILE)->hexdigest; if ( $md5s =~ $md5 ) { $lb->SetFont( Wx::Font->new( 7, wxDEFAULT, wxNORMAL, wxBOLD, # would like to set color somewhere in these properties 0, "Comic Sans MS" ) ); $lb->Append(" Match! | $sdk | $file | $filesize"); } else { $lb->SetFont( Wx::Font->new( 7, wxDEFAULT, wxNORMAL, wxBOLD, # would like to set color somewhere in these properties 0, "Comic Sans MS" ) ); $lb->Append(" Warning! | $sdk | $file | $filesize"); } } } } $frame->Show(1); $app->SetTopWindow($frame); $app->MainLoop;

    in the code above, it opens a window and when you drop a file on it, it runs it thru the "sub file". this sub is setup to open a directory and get md5 of everyfile in that directory, then open an exsisting md5 file and store it in array, then join the array into "$md5s". after that it also gets the filename ($file =~ s{.*/}{};) and get filesize ($filesize = -s $FILE;). after that, it compares the output of the "$md5" from each file in the directory against the stored "$md5s".
    if the $md5 from the files matches the md5s thats stored in $md5s, it will return true and append "" Match! | $sdk | $file | $filesize" to the listbox. if it returns false, it will append "" Warning! | $sdk | $file | $filesize". This is where i want to make the text red or green. if it returns true, i would like the text to be green, if it returns false i would like it to be red.
How do I space out each radio button horizontally in Perl/Tk
2 direct replies — Read more / Contribute
by Janish
on Jul 10, 2014 at 23:43

    Hi, anybody can help on this?

    As title says, how can I add horizontal spacing between a radio button and it's text? The text is way too close to the radio button make the gui looks weird. Below is my code (I tried columnspan and it seems doesn't works for me):

    $mw->Label(-text => 'Package Selection', -justify => 'left' )->grid(-sticky => 'w', -column => 0, -row => 1); my $package = 'normal'; foreach my $type (qw(normal pckg_A pckg_B)){ $mw->Radiobutton( -text => $type, -value => $type, -variable => \$package, #)->grid(-sticky => 'w', -column => 1, -row => 2); )->grid(-sticky => 'w', -column => 1, -row => 2, -columnspan=>20, +-padx => 50, ); }

    Thank you.

How to retrieve the port number on a Multiple TCP Chat Client Server
No replies — Read more | Post response
by thanos1983
on Jul 10, 2014 at 22:00

    Dear Monks,

    On my code every time a new user connects to the server I am binding his port into a hash $hash{$port} = $text[1]; for future reference through the: $new_sock->peerport() process, I pick up the port number.

    The moment that a new client will connect with the server this value will change, as expected, because $new_sock->peerport() is binded with $new_sock = $sock->accept(). The problem that I am having is that I can not find a way to separate the clients when they are communicating with the server.


    The goal is to be able to change the name of the client who is sending a message to the server, so I can make a small function to send this message to all clients apart from him self.

    Working sample of Server Code:

    Update the Server code: 3 and Solution with minor problem (It sends the message to all clients, I am trying to fix this sending the message to all clients apart from the one who sends the message.)! Update 2, I added the client code for experimentation purposes:

    I tried to retrieve the socket from two points: my @sockets = $readable_handles->can_write(); or $buf = <$sock>;. Since I this is the first server client that I am creating with the Select function I am not really familiar with it, and I can not find relative information to my problem online.

    Any advice would be much appreciated. Thank you all for your time and effort assisting me with my problem.

    Seeking for Perl wisdom...on the process...not there...yet!

Add your question
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?

    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 having an uproarious good time at the Monastery: (6)
    As of 2014-07-14 05:38 GMT
    Find Nodes?
      Voting Booth?

      When choosing user names for websites, I prefer to use:

      Results (255 votes), past polls