Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number

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.

New Questions
fetchrow_array loop in perl 5.10
5 direct replies — Read more / Contribute
by Anonymous Monk
on Sep 18, 2014 at 03:06
    We recently upgraded perl from 5.8 to 5.10

    we discovered after the upgrade that the fetchrow_array loop ends abruptly

    code snippet:
    my $searchSQL = $dbh->prepare($sql1);
    my $insertSQL = $dbh->prepare($sql2);

    while (my ($id,$name) = $searchSQL->fetchrow_array()) {

    if I comment out the "$insertSQL->execute($id,$name);" it loops thru all the records.

    the code perfectly works in 5.8 but not in 5.10

    any ideas?

Perl HTTP proxy experts
1 direct reply — Read more / Contribute
by gregaiken
on Sep 17, 2014 at 14:20

    I recently discovered Makino Takaki's boilerplade Perl proxy program ( I found this code to be relatively straight forward to use for the purpose of better understanding this mechanism and to experiment with.

    i've added a few lines of my own code to this boilerplate program, and am having trouble getting...

    $c->send_redirect("file:///C:/http_proxy_server/log.html", 303)

    to work as I'm wanting it to work. according to documentation, above command redirects the client to a new url, and the HTTP header code set to (in this case) 303 (meaning 'See Other'). when my Perl proxy is running, I am wanting to use it in a fun way (where I can send it 'commands' - encoded as URL get requests).

    with my web browser viewing a local file 'log.html' file (which contains many HTML forms). When I click one particular form, the form sends a get request like this 'http://proxycommand.code?function=AppendNewRecordToLogHtmlFile&newrecord=helloworld' to my Perl proxy server.

    my proxy program can then search the requested URL to see if it contains 'proxycommand.code'. if so, it then parses the GET query string to discover the special function I want my proxy to execute. In this case, the special function is to append a new record to the 'log.html' file, where the new record is 'hello world'.

    in my code, im able to successfully append the new record to 'log.html'. i sleep for a few seconds. i then send the above Perl command to tell the browser to redisplay the newly modified 'log.html' file

    in the chrome web browser, the browser itself is satisfied that its received a wellformed HTTP reply, the address field of the browser does reflect the newly requested local file. but since the browser was previosly viewing the exact same file (prior to my clicking the form submit button) - perhaps some caching mechanism is preventing the browser from showing the newly added record at the bottom of the 'log.html' file. if i manually click the chrome browsers 'refresh' button - this causes the appended new record to display in the browser.

    does anyone know why the browser is not displaying the newest version of the 'log.html' file? is this due to browser caching issues? if so, what is the solution? I would think this LWP-UserAGent module would automatically include a newer HTTP 'Date' header, but maybe its not, and i need to manually set this header myself? One website suggested setting a NON-standard HTTP header, 'Refresh: 1' which supposedly is used by most browsers but not an official part of RFC2616.

    any help here would be appreciated, as i'm a little confused

Gmail Send problem
2 direct replies — Read more / Contribute
by IvanH
on Sep 17, 2014 at 12:24

    Hello Monks,

    I am using Email::Send::SMTP::Gmail to send a newsletter. I set up a loop to send it to about 150 addresses. I know that the first few went successfully and the last few did not, so I suspect my coding to detect an error in the send is incorrect. I have been told that $mail will return -1 if it fails and therefore used the following code: Have I set this up correctly?

    $mail->send(-to=>"$email", -subject=>"$subject", -body=>"$emailtext",-contenttype=>'text/html'); if ($mail == -1) { die "Mail send error: $!\n"; } else { print "Success!\n\n"; print OUTFILE "Success!\n\n"; }

    Thanks for any help,


How to compare two dates?
4 direct replies — Read more / Contribute
by CountOne
on Sep 17, 2014 at 11:38
    Hi Monks, I am new to Perl and was wondering how to compare two dates in MM/DD/YYYY format. For example, if a date in column B is equal to or comes before the date in column A, return 1, otherwise return 0. How would DateTime be used for this range? Thank you for the help!
Spreadsheet::XSLX parsing workbook, but not retrieving values from cells
3 direct replies — Read more / Contribute
by divyahk
on Sep 17, 2014 at 06:35

    Hello, I am a newbie to Perl and have a problem with parsing an Excel file. I am using Spreadsheet::XLSX for reading data from an Excel file and extract each row of data, one row at a time. The code (partial) is as follows:

    use strict; use warnings; use Spreadsheet::Read; use Data::Dumper; my $excel = Spreadsheet::XLSX->new (‘xyz.xlsx'); if (!defined $excel) { die "Error: " . $excel->error() . "\n"; } print “Read with Spreadsheet::XSLX\n"; print Dumper($excel) . “\n";

    The output here shows that it’s reading the correct workbook as it can recognise the correct worksheet called “Paper.1”, and I think I am using the correct version of the Excel parser as it is indeed the .xlsx variety of Excel. Why are the cells not being read then? (As shown by cells =>undef)

    Read with Spreadsheet::XLSX : $VAR1 = bless( { 'Worksheet' => [ bless( { 'DefColWidth' => '8.43', 'MinCol' => 0, 'MaxRow' => 0, 'MinRow' => 0, 'path' => 'worksheets/sheet +1.xml', 'MaxCol' => 0, 'Name' => 'Paper.1', 'Cells' => undef }, 'Spreadsheet::ParseExcel:: +Worksheet' ) ], 'Flg1904' => 0, 'FmtClass' => bless( {}, 'Spreadsheet::XLSX::Fmt2007' + ), 'SheetCount' => 1 }, 'Spreadsheet::ParseExcel::Workbook' );
Problem creating animated GIF using GD and GD::Graph
2 direct replies — Read more / Contribute
by realityczar
on Sep 16, 2014 at 10:29
    Hi, Monks-

    I am trying to create an animated GIF of graphs using GD and GD::Graph. The following code creates individual graph GIF files, but the image.gif that results and is supposed to be the animated version won't open. Where have I gone wrong?

    Update: I searched the archives. I read them. And I didn't apply the wisdom. It's a lack of binmode. Sorry to have bothered you.

    use strict; use warnings; use GD; use GD::Graph::bars; my $img_width = 288; my $img_height = 216; my $number_of_hours = 24; my $img = GD::Image->new($img_width, $img_height); my $gifdata = $img->gifanimbegin(1,0); foreach my $hour (0..$number_of_hours-1) { my @h = CreateHistogram($hour); my @labels = 0..79; my @data = (\@labels, \@h); my $graph = GD::Graph::bars->new($img_width,$img_height); $graph->set( title => "HISTOGRAM HOUR $hour" ); my $gd = $graph->plot(\@data); $gifdata .= $gd->gifanimadd; open(FIL, ">image_$hour.gif"); binmode FIL; print FIL $gd->gif; close FIL; } $gifdata .= $img->gifanimend; open(GIF,">image.gif"); print GIF $gifdata; close GIF; exit; sub CreateHistogram { # stuff to create a histogram }
Looping in a Loop
5 direct replies — Read more / Contribute
by Violet
on Sep 16, 2014 at 08:42

    I am completely new to Perl and would like some feedback/assistance. Hoping I don't make anyone cringe too badly.

    Trying to open a list and use each item on the list to bring out information on that item from the open file. Items will be listed in the second column of the file, but if the item matches I need to print all columns for that file.

    When I list all the items out directly in my code instead of opening the list, the code works. However, when I add the element of opening the list, I get no readout whatsoever.

    There are no warnings, so I can't figure out what's wrong. The format of my list maybe?

    #! C:\Perl\bin\perl -w open (LIST, "List.txt" ); @mylist = (<LIST>); open (FILE, "FILE.txt" ); @myfile = (<FILE>); foreach $file(@myfile) { foreach $list(@mylist) { @temp = split (/\t/, $file); chomp @temp; if ( $temp[1] eq $list ) {print ("$file")} } }
How to push the first two elements of an array in another array
3 direct replies — Read more / Contribute
by Anonymous Monk
on Sep 16, 2014 at 05:25
    Hey Monks, I have a simple question, i really do not know, how to write it down. I have an Array
    @array1 = (1,2,3,4,5);
    and I want the first two elements (1 and 2) use in another Array.
    @array2 = (1,2);
    How do I do this? With grep? With splice? with push?? Thanks for your help
issue with DBI and MS SQL SERVER
3 direct replies — Read more / Contribute
by DanBev
on Sep 15, 2014 at 10:04

    Hi monks, I've an issue connecting to MS SQL Server with DBI. I've read all tutorials and configurations of TDS but my code still not works...

    Simply I try my $dbh = DBI->connect(DBI:Sybase:server=xx.xx.xx.xx, "USERNAME", "PASSWORD") ;
    and the error is

    DBI connect('server=xx.xx.xx.xx','USERNAME',...) failed: OpenClient me +ssage: LAYER = (0) ORIGIN = (0) SEVERITY = (78) NUMBER = (41) Server xx.xx.xx.xx, database Message String: Unable to connect: Adaptive Server is unavailable or d +oes not exist at line 19 Cant' connect to database: OpenClient message: LAYER = (0) ORIGIN = (0 +) SEVERITY = (78) NUMBER = (41) Server xx.xx.xx.xx, database Message String: Unable to connect: Adaptive Server is unavailable or d +oes not exist

    My TDS configuration is

    [xx.xx.xx.xx] host = xx.xx.xx.xx port = 1433 tds versione = 7.0

    Instead, trying in shell it works

    root@___# /usr/local/freetds/bin/tsql -S -U USER Password: locale is "it_IT.UTF-8" locale charset is "UTF-8" using default charset "UTF-8" 1>

    Please help me to understand... is missing
1 direct reply — Read more / Contribute
by timpoiko
on Sep 15, 2014 at 09:06
    Hello all Monks. I wanted to take GD:SVG in use, so I wrote man GD::SVG and read it. I found a piece of code, so I took it and tried to run.
    #!/usr/bin/perl use strict; use GD::Simple; GD::Simple->class('GD::SVG'); my $img = GD::Simple->new(500,500); $img->bgcolor('white'); $img->fgcolor('blue'); my $g1 = $img->newGroup('circle in square'); $g1->rectangle(100,100,400,400); $g1->moveTo(250,250); my $g2 = $g1->newGroup('circle and boundary'); $g2->fgcolor('black'); $g2->bgcolor('red'); $g2->ellipse(200,200); print $img->svg;
    However, only outcome from this is:
    $ perl Can't locate auto/GD/ in @INC (@INC contains: /etc/perl /us +r/local/lib/x86_64-linux-gnu/perl/5.20.0 /usr/local/share/perl/5.20.0 + /usr/lib/x86_64-linux-gnu/perl5/5.20 /usr/share/perl5 /usr/lib/x86_6 +4-linux-gnu/perl/5.20 /usr/share/perl/5.20 /usr/local/lib/site_perl . +) at /usr/lib/x86_64-linux-gnu/perl5/5.20/GD/ line 1007.
    Googling does not help at all and I can't found this "" from the CPAN nor Debian's package repositories. So what I can to do to get this example code working?
Need regex to filter out unwanted rows
2 direct replies — Read more / Contribute
by ps2931
on Sep 15, 2014 at 07:29
    Hello monks!

    I'm trying to filter out rows from a large text files based on the criteria -

    The allowed charcters are: aA-zA, underscore(_), colon(:), dot(.), forward slash(/), comma(,), hyphen(-) numbers(0-9) and double quotes (" ").

    Any character other than the characters listed above is invalid. I want to print line which failed the criteria. The sample line from test file is something like:

    2749 "CQWERC20F+XZIAQAAAQjLiDI9sNc=", "1","ds_uid","CWER1Y1mHZIAQAA8di +wRHfuwrM=","2012-10-14 18:41:44.429","2012-10-14 18:41:44.572","1975- +10-10 00:00:00.000","7307 mg rd","","naasik","NK","44026","IN","44063 +59999","","","","DEFAULT","","","AABBCCXX","","Qqwwee<feff>","","qqww","0","YOPANEL","","false","en","","","","","","","",""," +","","","","","","","",""

    The above line is invalid since it has '<' symbol. Can anyone help me?

Multiline Regex replacement in Multiline file
2 direct replies — Read more / Contribute
by akamboj84
on Sep 15, 2014 at 02:28

    Hello Experts, I am kind of stuck in code. I am trying to do multi regex replacement in multiline file. However my scripts is unable to do replacement, I am not able to figure out why? Can someone help me please

    ->>Script Code

    my $def="hashpatterns.txt"; my %dic=(); open(D, $def) || die "can't open definition file:$def\n"; while (<D>) { my ($oldp, $newp) = split /#/; $dic{$oldp}=$newp; } close(D); my $file="input.txt"; open(F, $file) || die "can't open definition file:$file\n"; open(W, '>out.txt') or die "can't write to file:$!\n"; my $line=join "", <F>; my $matchkey=join "|", keys %dic; $matchkey=qr /$matchkey/; $line =~ s%$matchkey%$dic{$matchkey}%g; print W $line; close(F);

    --> hashpatterns.txt

    \s+user\s"[^"]+"\s+password\s"[^"]+"\s+hash2\s+access(\s+console){2}(\ +s+new-password-at-login)?(\s+member\s"(default|engineer|networktest)" +){2}(\s+exit){0,2}#REPLACE1

    \s+user\s[^"]+"\s+password\s[^"]+"\s+hash2\s+access(\s+console){2}(\s+ +new-password-at-login)?(\s+member\s"(default|READ-ONLY)"){2}(\s+exit) +{0,2}#REPLACE2

    \s+user\s"[^"]+"\s+password\s"[^"]+"\s+hash2\s+access(\s+(console|snmp +|li)){3}\s+console(\s+new-password-at-login)?(\s+member\s"(default|LI +|li-prof1)"){2}(\s+exit){0,2}#REPLACE3


    user "testuser1" password "08Cl3V.leJKU/GskqArA0Yp4MFo" hash2 access console console new-password-at-login member "default" member "engineer"

    user "v-test" password "VCp0GjSBK/KiWW.PgkQp7swXVMZ" hash2 access console console new-password-at-login member "default" member "READ-ONLY"

New Meditations
The Case for Macros in Perl
5 direct replies — Read more / Contribute
by einhverfr
on Sep 12, 2014 at 23:07

    In some of my work I have started doing a lot more with higher order and functional Perl programming. A good example is PGObject::Util::DBMethod which provides a way to declaratively map stored procedures in Postgres to object methods. I have linked to the source code on github above because it is a good example of where macros would be very helpful.

    Now I will be the first to admit that in these cases, macros are not 100% necessary. The module above can accomplish what it needs to do without them. However the alternative, which means effectively creating a highly generalized anonymous coderef, setting up a custom execution environment for that coderef, and then installing the generalized coderef with the specific execution environment as a method has some significant drawbacks.

    Here's the particular section that does the main work:
    sub dbmethod { my $name = shift; my %defaultargs = @_; my ($target) = caller; my $coderef = sub { my $self = shift @_; my %args; if ($defaultargs{arg_list}){ %args = ( args => _process_args($defaultargs{arg_list}, @_) + ); } else { %args = @_; } for my $key (keys %{$defaultargs{args}}){ $args{args}->{$key} = $defaultargs{args}->{$key} unless $args{args}->{$key} or $defaultargs{strict_ar +gs}; $args{args}->{$key} = $defaultargs{args}->{$key} if $defaultargs{strict_args}; } for my $key(keys %defaultargs){ next if grep(/^$key$/, qw(strict_args args returns_objects) +); $args{$key} = $defaultargs{$key} if $defaultargs{$key}; } my @results = $self->call_dbmethod(%args); if ($defaultargs{returns_objects}){ for my $ref(@results){ $ref = "$target"->new(%$ref); } } if ($defaultargs{merge_back}){ _merge($self, shift @results); return $self; } return shift @results unless wantarray; return @results; }; no strict 'refs'; *{"${target}::${name}"} = $coderef; }

    Now that is 40 lines of code and 30 lines of it go into the coderef which is executed when the method is actually run. This doesn't seem too much but it does the work of 5-10 lines of code in an imperative style. In other words, it is 5-6 times as long and intensive as it needs to be.

    With macros, it would be quite possible to generate only the code needed for the specific function rather than creating a generalized case which has to handle many non-applicable inputs, and then create a context where it only gets what it needs.

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 chilling in the Monastery: (8)
As of 2014-09-18 23:54 GMT
Find Nodes?
    Voting Booth?

    How do you remember the number of days in each month?

    Results (128 votes), past polls