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

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
connect string for sybase
2 direct replies — Read more / Contribute
by fionbarr
on Jul 25, 2014 at 12:44
    I have been given the following:
    DB_URL=jdbc:jtds:sybase://ddd.ddd.ddd.dd:ddddd/xxxxxx DB_USERNAME=user DB_PASSWORD=password
    Can anyone suggest how I should format a connect string for DBI?
Tk::BrowseEntry set function -solved
2 direct replies — Read more / Contribute
by glenn
on Jul 25, 2014 at 11:40

    Hi monks. So because I love pain I want to know if anyone else has found such a solution to this bug lack of functionality. The BrowseEntry which provides a drop down has 3 functions: insert, delete, and get. I want a fourth 'set', rather than defining yet another global var as I already pass the obj to insert/delete I would love to be able to '->set(0)' to set the current value to index 0 of the list. Any suggestions or pointing in the correct direction would be appreciated. Thank you for your time.

Storing part of a regex in a variable
1 direct reply — Read more / Contribute
by jonneve
on Jul 25, 2014 at 11:37
    Hello all, I'm writing a rather complex script for converting C++ code to Pascal. A number of patterns or sub-pattern occur rather often, and therefore, I'm trying to put them into variables for later use. Here are my variables :
    $braces = qr/(?<braces>\{ ([^\{\}] | (?&braces))*? \} )/x; $brackets = qr/(?<brackets>\( ([^\(\)] | (?&brackets))*? \))/x; $identifier = qr/(?<identifier> \w+($brackets)?( \s*(\.|->)(?&identifi +er))?)/;
    The $brackets and $braces variables work as I expected, but the $identifier variable doesn't work right, for example :
    #This works $meth_impl =~ s/((?<identifier> \w+($brackets)?( \s*(\.|->)(?&identifi +er))?)) \s* \. \s* Trim\(\)/Trim($1)/xg; #This doesn't match anything: $meth_impl =~ s/($identifier) \s* \. \s* Trim\(\)/Trim($1)/xg;
    As you can see in the example above, I'm using the $brackets variable in both cases, and it works nicely. Could the problem be that my $identifier variable itself includes the $brackets variable? Do I need to eval it or something to force it to interpolate it correctly? Thanks in advance, Jonathan Neve
I am not able to install DBD::Sybase module using cpan on windows as well as Ubuntu
1 direct reply — Read more / Contribute
by ashish.gupta
on Jul 25, 2014 at 08:50
    Hi, I am not able to install DBD::Sybase module using cpan on windows as well as Ubuntu. I am getting below error when I am try to install DBD::Sybase perl module. Error : "cpan> install DBD::Sybase Running install for module 'DBD::Sybase' Running make for M/ME/MEWP/DBD-Sybase-1.15.tar.gz Fetching with LWP: Fetching with LWP: Checksum for D:\wamp\bin\cpan\sources\authors\id\M\ME\MEWP\DBD-Sybase-1.15.tar.gz ok Building M/ME/MEWP/DBD-Sybase-1.15.tar.gz Please set SYBASE in CONFIG, or set the $SYBASE environment variable at Makefile .PL line 120, <IN> line 44. Warning: No success on commandD:\wamp\bin\perl\bin\perl.exe Makefile.PL MEWP/DBD-Sybase-1.15.tar.gz D:\wamp\bin\perl\bin\perl.exe Makefile.PL -- NOT OK Running make test Make had some problems, won't test Running make install Make had some problems, won't install Stopping: 'install' failed for 'DBD::Sybase'. Could not read metadata file. Falling back to other methods to determine prerequ isites Failed during this command: MEWP/DBD-Sybase-1.15.tar.gz : writemakefile NO 'D:\wamp\bin\pe rl\bin\perl.exe Makefile.PL' returned status 512" Thanks In advanced. Please guide me what can i do for resolve this error. Thanks, Ashish
Matching/replacing a unicode character only works after decode()
4 direct replies — Read more / Contribute
by FloydATC
on Jul 25, 2014 at 06:10

    After hours of struggling with a seemingly simple problem involving utf8 I finally made it work -- but I have no clue why. Allow me to explain.

    I have a script which scrapes a particular web site for data about communication links. The data is utf-8 encoded and contains (among a great many other things) the unicode character 'GREEK SMALL LETTER MU' (U+03BC) which (after being scraped, put through several scripts, stored in MySQL, later extracted and presented on a web page) renders as "μ". My co-workers didn't really mind but after a couple of years it started to annoy me so much I reached the point where I just had to fix it. Today was that day.

    I wanted to replace all occurences of this character with either unicode character 'MICRO SIGN' (U+00B5) which renders as expected, or (even better) simply with the HTML entity &micro;.

    The method in question produces clickable links to present each commlink in many different contexts.

    sub commlink { my $self = shift; return "" unless $self->{'id'}; my $label = $self->{'label'}; $label =~ s/\x{00b5}/\&micro;/g; $label =~ s/\x{03bc}/\&mu;/g; # Looks almost exactly the same as &mi +cro; return "<A href=\"commlink.html?id=".$self->{'id'}."\" class=\"".$se +lf->{'state'}."\">".$label."</A>"; }

    I knew the data stored in MySQL was utf8, the string was untoched and the web page charset was specified as utf8. If I tried to change it, the norwegian characters on the same page would become garbled so I knew the encoding setting was sent and detected properly.

    So... utf8 in, no encoding/decoding or string mangling prior to the regex... and still the regex didn't match.

    The solution?

    sub commlink { my $self = shift; return "" unless $self->{'id'}; my $label = $self->{'label'}; $label = decode('utf8', $label); # Why? It's already utf8 and I need + it to stay utf8 $label =~ s/\x{00b5}/\&micro;/g; $label =~ s/\x{03bc}/\&mu;/g; # Looks almost exactly the same as &mi +cro; return "<A href=\"commlink.html?id=".$self->{'id'}."\" class=\"".$se +lf->{'state'}."\">".$label."</A>"; }

    My question is... Why?! Before decoding the utf8 string, how could the string go from input to output unchanged but fail to match the regex? Why do I need to decode the utf8 string to match an utf8 character when the string already prints as an utf8 character? This is so confusing...


    OK, thanks for the pointers. It sounds so very very simple in theory, but in practice... This system is made up from more than 50 different scripts and modules that shuffle data back and forth and present it via HTML, SVG, generates javascript, text messages, emails and what have you. After I started trying to fix things to "do it right" then absolutely everything broke. I'm going to need weeks to get on top of this.

    This is exactly why I have always hated Unicode. Why, oh why could I not have left this stupid bug alone.

    -- FloydATC

    Time flies when you don't know what you're doing

Subroutine & For loop
5 direct replies — Read more / Contribute
by Anonymous Monk
on Jul 25, 2014 at 06:08
    Dear Monks, I would like to call a subroutine repeatedly based on a condition from a for loop and each time pass different parameters. My code is calling the subroutine only the first time. I am not sure which is the correct format to call a subroutine from a for loop. Please help. Thank you!
Problem with creating Files
2 direct replies — Read more / Contribute
by David92
on Jul 25, 2014 at 05:31
    Hey Monks,

    This is a very big program, so it might be, that I wont get an answer here, due to not understanding what do I seek help for, I'll try my best to explain.


    I have a problem when I create HTML pages with PERL. I use 2 Arrays. In FirstArray there are more elements than in SecondArray.

    When I start to create HTML's, I use in one of the Navigation Menus the list of elements in FirstArray.

    When you chose one element in the menu, it will open a new HTML (firstArray1.html) that wil display some statistics in a chart.

    That HTML has two buttons below the chart: FirstArray and SecondArray (name of buttons).

    If you click on SecondArray it will switch from current HTML (firstArray1.html) to (secondArray1.html). And then again if you click on FirstArray button it will switch to (firstArray1.html). The problem is that the FirstArray has more elements than SecondArray. And those elements that are NOT in the SecondArray are causing problems: Lets say we are in firstArray5.html and by clicking SecondArray button the page will try to load secondArrray5.html - HOWEVER there is NONE, because secondArray does not have that element as firstArray has.

    I have to keep the code as it is (all other 1000 lines of code). I have a seperate sub where I create the buttons:

    sub createButtons{ ($outfile,$filename)=@_; $replace = 'ay'; $find = 'DFT'; if(index($filename, $find) != -1){ $filenameDFT = $filename; $filenameLAY = $filename; $filenameLAY =~s/$find/$replace/; print $outfile " <a href='./$filenameLAY' class='button_l +ay'>Layout</a> <a href='./$filenameDFT' class='button_dft'> +DfT</a>\n </div>\n"; } #print "$filenameDFT\n"; else { $filenameLAY = $filename; $filenameDFT= $filename; $filenameDFT =~s/$replace/$find/; print $outfile " <a href='./$filenameLAY' class='button_l +ay'>Layout</a> <a href='./$filenameDFT' class='button_dft'> +DfT</a>\n </div>\n"; } return(@OutputButtons) }

    Filename is for e.g. firstArray1.html. I use a foreach loop in other subs to go over all elements in firstArray and another to go through all elements of secondArray.

    In real example filename is: file1LAY.html and file1DFT.html ... that is why I use the index, because I need a button to work for every HTML (filename). I want to make it so, that if file does not exist (but the reference is stored in one of the Buttons) it should change the reference to '#'

    This is a hard challenge, but I am in despair, so atleast I can try to ask, someone might have an idea.

How to retain popup_menu selection between form submission
2 direct replies — Read more / Contribute
by ghosh123
on Jul 25, 2014 at 03:25

    Hi Monk
    I am working on a web application which looks like

    Case I

    Given a hostname provided in the text field if I press the
    "Show jobs" button, it submits a form and loads the
    same page with a popup_menu populated under the text
    field and "Show jobs" button with all the jobs
    running on that host.
    Now I select a job in the popup_menu by a mouse click
    on the values listed in the popup_menu. All fine so far.

    Case II

    Now to the right-hand side of this case -I gui objects, I
    have another text field and "Show jobs" button. If I carry
    out the same operation as I did in case-I on this
    text-field and "Show jobs" at the right-hand side , it
    submits the form and fetches one more popup_menu with
    all the jobs running on this new host.
    In addition to that the case-I text-field, submit button and popup_menu also appears on the reloaded page.
    But the problem is the Case-I selection in the popup_menu is getting lost.

    Please help me on how can I retain that Case-I selection as well when the page is submitted in Case-II and reloaded.
    A sample code I am giving here below, the variables used in popup_menu are the usual array refs used in any such implementation and $qry is the cgi object.

    <table border=0> <tr> <th bgcolor="#CCCCEE">First_Host</th><th>&nbsp;</th><th +bgcolor="#CCCCEE">Second_Host</th> </tr> <tr align=center> <td nowrap>@{[ $qry->textfield(-name=>'HOST_1') . '&nbsp; +' . $qry->submit(-name=>'HOST_1_LIST', -value=>'Show jobs') ]}</td> <td>&nbsp;</td> <td nowrap>@{[ $qry->textfield(-name=>'HOST_2') . '&nbsp; +' . $qry->submit(-name=>'HOST_2_LIST', -value=>'Show jobs...') ]}</td +> </tr> <tr align=center> <td bgcolor="#EEEEEE">@{[ $qry->popup_menu(-id=>'PM1', -n +ame=>'PM1_JOBS', -size=>10, -values=>$old_values, -labels=>$old_label +s, -multiple=>'false', -override=>'true', -onChange=>"fetchjobs(id,'' +,'','')") ]}</td> <td bgcolor="#EEEEEE">@{[ $qry->popup_menu(-id=>'PM2', -nam +e=>'PM2_JOBS', -size=>10, -values=>$new_values, -labels=>$new_labels, + -override=>'true', -onChange=>"fetchjobs(id,'','', '')") ]}</ +td> </tr> </table>
Perl code for finding shortest path not working on large files
3 direct replies — Read more / Contribute
by zing
on Jul 25, 2014 at 03:03
    I have this code which takes in an input file and prints out shortest path from each child to the parent "Q". Each child has to find a shortest path to "Q" only, if that path exists then print else print blank.

    perl input_fie output_file

    #! /usr/bin/perl #=======================Processing the input file===================== +===# print "Enter file name:\n"; chomp(my $file = <STDIN>); open(DATA,$file) or die "failed opening file!!"; my %DEF = ( I => [qw( P Pl P.P P.Pl Pl.P Pl.Pl P.P.P P.P.Pl P.Pl.P P.Pl.Pl Pl. +P.P Pl.P.Pl Pl.Pl.P Pl.Pl.Pl )], II => [qw( E P.E Pl.E P.P.E P.Pl.E Pl.P.E Pl.Pl.E )], III => [qw( E.P E.Pl P.E.P P.E.Pl Pl.E.P Pl.E.Pl E.P.P E.P.Pl E.Pl.P + E.Pl.Pl )], IV => [qw( E.E P.E.E Pl.E.E E.P.E E.Pl.E E.E.P E.E.Pl E.E.E )] ); # Hash table/dictionary for all the groups my @rank = map @$_, @DEF{qw(I II III IV)}; my %rank = map {$rank[$_-1] => $_} 1..@rank; my @group = map {($_) x @{$DEF{$_}}} qw(I II III IV); my %group = map {$rank[$_-1] => $group[$_-1]."_".$_} 1..@group; sub rank { $rank{$a->[2]} <=> $rank{$b->[2]} } my %T; sub oh { map values %$_, @_ } sub ab { my ($b, $a) = @_; [$b->[0], $a->[1], qq($a->[2].$b->[2]), qq($b->[3]<-$a->[3])] } sub xtend { my $a = shift; map {ab $_, $a} oh @{$T{$a->[0]}}{@_} } sub ins { $T{$_[3] //= $_[1]}{$_[2]}{$_[0]} = \@_ } ins split /,\s*/ for <DATA>; #ins split /,\s*/ for $filename; ins @$_ for map {xtend $_, qw(P E Pl)} (oh oh oh \%T); ins @$_ for map {xtend $_, qw(P E Pl)} (oh oh oh \%T); for (sort {rank} grep {$_->[1] eq 'Q'} (oh oh oh \%T)) { printf "%-4s: %20s, %-8s %6s\n", $_->[0], qq($_->[0]<-$_->[3]), $_->[2], $group{$_->[2]}; }
    The program works fine on the undermentioned small sample file.

    SAMPLE_INPUT ( 1st column is child, 2nd column is its parent, 3rd column is relation). So for example 1st row means, M19 is child of Q and relation is P.

    M19,Q,P, M31,M19,Pl, M420,M31,E, M421,M31,E, M33,M31,E, M438,M33,Pl, M445,M33,E, M437,M33,E, M444,M33,E, M73,M33,E, M552,M73,Pl, M553,M73,Pl, M569,M73,E, M549,M73,E, M550,M73,E, M73,Q,P,
    OUTPUT (column 1 represents child, column 2 is shortest path from that child to parent "Q" if it exists, column 3 is the concatenated relation for each individual path, column 4 is the group_id from DEF.)
    M19 : M19<-Q, P I_1 M73 : M73<-Q, P I_1 M31 : M31<-M19<-Q, P.Pl I_4 M552: M552<-M73<-Q, P.Pl I_4 M553: M553<-M73<-Q, P.Pl I_4 M549: M549<-M73<-Q, P.E II_16 M569: M569<-M73<-Q, P.E II_16 M550: M550<-M73<-Q, P.E II_16 M33 : M33<-M31<-M19<-Q, P.Pl.E II_19 M420: M420<-M31<-M19<-Q, P.Pl.E II_19 M421: M421<-M31<-M19<-Q, P.Pl.E II_19

    But it fails on a input file of say 2000 lines the download link for this file

    Please help me on this.

Understanding Inline::C to call vendor libraries
2 direct replies — Read more / Contribute
by murrayn
on Jul 25, 2014 at 02:31
    I have installed and successfully tested Inline::C with a simple "Hello World" and vowel counter (from the Inline::C Cookbook) so I'm reasonably happy that the installation is correct. I now want to invoke a vendor's C written API from Perl. The vendor's sample C code includes the line: #define SHLIBNAME “dptcpiphi.dll” My Perl code includes the following in order to access (I pray) the functions which I expect to be contained in dptcpiphi.dll:
    use Inline C => Config => AUTO_WRAP => ENABLE; use Inline C => Config => LIBS => '-L"C:\Program Files\Common Files\Pr +oduct\4.1\dptcpiphi.dll" -ldptcpip';
    The full Perl script is short:
    #!/usr/bin/perl -w use Inline C => Config => AUTO_WRAP => ENABLE; use Inline C => Config => LIBS => '-L"C:\Program Files\Common Files\Pr +oduct\4.1\dptcpiphi.dll" -ldptcpip'; use Inline C => DATA ; use strict; my $DPbuff = "statusbuffer"; my $status = MyGetCtrlStatus('0x14','localhost','1703',$DPbuff); print "$status\n"; __END__ __C__ int MyGetCtrlStatus(char ShiftCmd, char pHostName, char uPortNum, char + pCtrlStatus) { char JobInfo; int status = DPGetCtrlStatus(ShiftCmd, pHostName, uPortNum, pCtrlS +tatus); printf ("Running...\n"); return pHostName; }
    The gcc compile step appears to complete successfully but when it comes time to link the object libraries together it fails:
    Test_pl_5261.o:Test_pl_5261.c:(.text+0x27): undefined reference to `DP +GetCtrlStatus' collect2: ld returned 1 exit status dmake.exe: Error code 129, while making 'blib\arch\auto\Test_pl_5261\ +Test_pl_5261.dll'
    (I know the code isn't going to work at present but I can fix that as long as I can get Inline::C to link the vendor libraries into my Perl script.) Have I completely misinterpreted the purpose and capabilities of Include::C or simply made a mess of using the tool?

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 scrutinizing the Monastery: (4)
    As of 2014-07-26 11:57 GMT
    Find Nodes?
      Voting Booth?

      My favorite superfluous repetitious redundant duplicative phrase is:

      Results (176 votes), past polls