Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

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
[KSH convert to PERL] Rollup multi line values to single row outputs.
2 direct replies — Read more / Contribute
by captainK
on Jan 26, 2015 at 11:14

    Dear Monks,

    i've been doing the following for years in KSH with something like the below but need to do it in Perl now. i have been trawling your site and the web for days now and am totally lost on how to do it in a script.

    Tried numerous while and foreach (<MYFILE>) examples and using split on ":" etc etc.. They all seem to either print the below every time for every line multiple times (like a cartesian join) of grabled mess. I have so many hacks that have failed i dont want to bother you with them. basically we need to do the following in PERL that we are currently doing in KSH.

    Any assistance would be most greatly appreciated.

    br&thnx, karl

    Here's the KSH with for loop, cut, grep:

    #!/bin/ksh for t in $(cat $MYFILE) do job_name=`echo $t | grep job_name | cut -d: -f2` days_of_week=`echo $t | grep days_of_week | cut -d: -f2` start_times=`echo $t | grep start_times | cut -d: -f2` printf "$job_name:$days_of_week:$start_times" done

    ----- Example (Target Output) ------,mo,tu,we,th,fr,sa:"12:00",mo,tu,we,th,fr,sa:"12:00",mo,tu,we,th,fr,sa:"12:00"
    ----- MYFILE (Source DATA) --------- /*----- -----*/ days_of_week: su,mo,tu,we,th,fr,sa start_times: "12:00" /*----- -----*/ days_of_week: su,mo,tu,we,th,fr,sa start_times: "12:00" /*----- -----*/ days_of_week: su,mo,tu,we,th,fr,sa start_times: "12:00"
Object accessors with unknown data
5 direct replies — Read more / Contribute
by Amblikai
on Jan 26, 2015 at 05:43

    Hi Monks! I have a quick question with regards to building objects. My search keeps bringing up references to Moose et al, but i don't want to use an external object system. I'm practicing OOP with bog standard perl for my own education!

    With that in mind, i'm writing a program where i'm not going to know the data i have when constructing the object. In the past i've always known the name and type of each attribute so i can construct accessors and methods to check that the attribute data is correct etc.

    Now i'm stuck though! How do you write accessors for unknown attributes?


NDBM problem
1 direct reply — Read more / Contribute
by RuntimeError
on Jan 26, 2015 at 05:26
    Dear Monks,

    I have RedHat 6 and Perl 5.10 shipped with it. Since a recent update NBDM fails: in my case it is an errno 17 (more precise: it is Term::Clui database that is called and fails with the ndbm error). The database was created with the correct rights, etc. and the exact same program worked correctly until the update of the system.
    Do you know which might be the trouble here? Any dependencies I don't know about? I dont have much information for you but any hint is highly appreciated.
    I can disable the database in Term::Clui that is not my real concern.
    I am worried that the whole database mechanism in Perl might be broken...

    PS: I am using version 1.8 of gdbm (the latest version according to yum).
Copy XML file, write new attributes and move the old files.
4 direct replies — Read more / Contribute
by Nevamonk
on Jan 26, 2015 at 03:00
    Hello guys,

    I seek your wisdom regarding the copying of an XML-file. Basically, this script will read incoming XML files, matches them to a database, where some ID's may need to be overwritten, but i need to keep the old data file to. So i was thinking of copying the file and matching the new file to database, overwriting the attributes in both name and value. Now how do i copy an XML file and bind it to a variable?

    use warnings ; use strict ; use XML::LibXML; use DBI ; use File::Copy qw(copy); my $xmlInputFile = ""; my $dbConnection =""; my $parser = XML::LibXML->new(); my $databasename = "test_db"; my $hostname = "localhost"; my $username = "rrdtool"; my $password = ""; my $elemNameID; my $elemID; my $elemValueID; my $elemValueList; my $xmlOutputFile; my $matchRefFile; #=========================================# # SUB-Routines # #=========================================# sub connectDatabase { my $bConnected = 0; $dbConnection = DBI->connect( "dbi:mysql:database=$databasename;ho +st=$hostname", $username, $password ); if ( $dbConnection ) { $bConnected = 1; } else { print "There was an error connecting to : $databasename => $DB +I::errstr\n"; } return $bConnected; } #=========================================# sub WriteToLog { my ( $logline ) = @_; open ( LOGFILE, '>>RRDTool_translate_test.log'); print LOGFILE $logline; close ( LOGFILE ); } #=========================================# sub createNewXmlFile { #open my $matchRefFile, '<', ""; #binmode $matchRefFile; # drop all PerlIO layers possibly created + by a use open pragma #my $doc = XML::LibXML->load_xml(IO => $matchRefFile); #open my $xmlOutputFile, '>', 'xmlOutputFile.xml'; #binmode $xmlOutputFile; # as above # $doc->toFH($xmlOutputFile); # or #print {$xmlOutputFile} $doc->toString(); copy $xmlInputFile, $xmlOutputFile; rename $xmlOutputFile, 'xmlOutputFile.xml'; } #=========================================# sub matchNodeDB { if ( 1 == connectDatabase) { my $sqlSelectQuery = ( "SELECT IF NOT EXISTS * FROM XMLelementen + WHERE name ='$elemNameID' ELSE INSERT INTO XMLelementen VALUES ('$el +emNameID')"); my $query_handle = connectDatabase->prepare ( $sqlSelectQuery ); $query_handle->execute(); $query_handle->bind_columns(undef, \$elemID); return $elemID; } else { WriteToLog ("failed to get / insert $elemNameID from Database.\n +"); die (WriteToLog ("exitting on failed matchNodeDB sub for [$elemN +ameID]\n Exitting...\n")); } } #=========================================# sub WriteToFile { open ( OutputFile, '>>$xmlOutputFile'); $elemNameID->set_att(p => $elemID); $elemValueID->set_att(p => $elemID); WriteToLog ("Overwriting attribute ID's for $matchRefFile"); close ( OutputFile ); } #=========================================# sub escapeQuotes { my ( $inString ) = @_; # Escape single quotes $inString =~ s/\'/\\'/g; # Escape double quotes $inString =~ s/\"/\\"/g; # Escape the @-symbol $inString =~ s/\@/\\@/g; return $inString; } #=========================================# sub readXmlFile { my ( $xmlDir, $xmlInputFile ) = @_; WriteToLog ( "Parsing: $xmlInputFile"); my $matchRefFile = $parser->parse_file ("$xmlDir/$xmlInputFile"); createNewXmlFile ( $xmlDir, $xmlInputFile, $xmlOutputFile ); my $qryElemName = ("/mdc/md/mi/mt"); my $qryElemValue = ("/mdc/md/mi/r"); for my $manElemList ( $matchRefFile->findnodes ( $qryElemName )) { my $elemNameID = $manElemList->getAttribute( "p"); foreach ($elemNameID) { my $elemValueList = ( $matchRefFile->findnodes ( $qryElemValu +e )); my $elemValueID = ( $elemValueList->getAttribute ( "p" )); if ($elemNameID == $elemValueID) { matchNodeDB ($elemNameID); WriteToLog ("Binding [$elemID] to [$elemNameID]"); WriteToFile ( $elemID, $elemNameID, $elemValueID, $xmlOutp +utFile ); } } WriteToLog ( "\n"); } WriteToLog ( "\n"); } #=========================================# + sub readXmlDir { my ( $xmlDirectory ) = @_; opendir (DIR, $xmlDirectory ) or die $!; while ( my $xmlFile = readdir( DIR ) ) { next unless ( -f "$xmlDirectory/$xmlFile" ); next unless ( $xmlFile =~ m/\.xml$/ ); WriteToLog ( "Matching: [$xmlFile] to database.\n"); readXmlFile ( $xmlDirectory, $xmlFile ); } closedir ( DIR ); } #=========================================# ## < MAIN ENTRY > WriteToLog( "RRD Tool Translate test Version: $version ( $copyright )\ +n"); WriteToLog( "Matching $xmlInputFile to Database: $databasename \n"); if ( 1 == connectDatabase() ) { readXmlDir( "/home/rrdtool") } else { WriteToLog ( "No Database connection established, exiting") }
Scrambling help
3 direct replies — Read more / Contribute
by Anonymous Monk
on Jan 25, 2015 at 15:46

    a couple of days ago i asked tou guys here for help and you delivered like gods so here i am again with another problem so pls help

    Write a script which will do a simple scrambling of a string. The script should have variables for the original string (eg $message) and a number (eg $number) (which should be less than the length of the string). The scrambling should be achieved by reversing the first and last $number characters of $string (in that order). To avoid giving any hints as to the values used the scrambled string should appear all in lowercase.

    For example:

    String=Babraham Number=2, Scrambed= abbrahma String=Institute Number=3, Scrambled=snititetu

    Hint: use the substr() and reverse() functions.

Print the string out in alternating upper and lowercase letters LiKe tHiS.
4 direct replies — Read more / Contribute
by Anonymous Monk
on Jan 25, 2015 at 14:25
    hello iv just coded with perl for a few days and my teacher are asking me to do as the title say "Print the string out in alternating upper and lowercase letters LiKe tHiS." but i have no idee on how to do it, pls help
How can I connect to an HTTPS server using the Perl JIRA::Client::Automated module through Proxy?
No replies — Read more | Post response
by hanish_cbit
on Jan 25, 2015 at 14:23

    I am new to use JIRA and REST API.Please tell me how to connect to HTTPS jira server using JIRA::Client::Automated module. I am trying to connect to jira server using below code.

    use strict; use warnings use JIRA::Client::Automated; my $user = 'foo'; my $pass = 'bar'; my $url = ''; my $jira = JIRA::Client::Automated->new($url, $user, $pass); my $ua = $jira->ua(); $ua->proxy('http', ''); $search_results = $jira->search_issues(project in (sample), 0, 1000); my $count = $search_results->{'total'}; print "$count";

    But using the above code always gives me an 500 error saying Unable to connect. Since I am trying to connect from my Local Machine, the request is not going through Local system proxy. Please let me know how to connect through Proxy

    I am able to access the same rest url using the webbrowser of my local machine. Please suggest if I am doing anything wrong.

pl c sv text format wrap
4 direct replies — Read more / Contribute
by edrew04
on Jan 25, 2015 at 04:36

    Hi can you help me on creating a pl of c sv text format example:


    1,Go,Manuel,V.,1/22/2015,8:30AM,5:30PM,1001 2,Calinisan,Peter,S.,1/22/2015,8:30AM,5:30PM,1002 3,Sioting,Michael,S.,1/22/2015,8:30AM,5:30PM,1003

    After running the ksh wrapper it should become like this:

    2002,Go,Manuel,V.,1/22/2015,8:30AM,5:30PM,IT 2001,Calinisan,Peter,S.,1/22/2015,8:30AM,5:30PM,HR 2003,Calinisan,Peter,S.,1/22/2015,8:30AM,5:30PM,PURCHASING

    here are my ff file names:

rough approximation to pattern matching using local
5 direct replies — Read more / Contribute
by gregory-nisbet
on Jan 25, 2015 at 00:42
    I am, as an exercise, trying to write a function that mimics pattern matching in langauges like Haskell and OCaml in Perl. The following code runs (I'm using Perl 5.18) and produces the following result.
    $ perl Name "main::bob" used only once: possible typo at +line 50. Use of uninitialized value $bob in print at line 5 +0.
    I think that's because the while loop
    while (my ($k, $v) = each %$locals) { local ${$k} = $v; }
    localizes each variable only within the body of the loop. I'm wondering what the right approach would be. Entire code below.
    use strict; use warnings; sub same_keys { my ($left, $right) = @_; return unless ref $left eq 'HASH' and ref $right eq 'HASH'; return unless keys %$left == keys %$right; for my $key (keys %$left) { exists $right->{$key} or return; } return 1; } sub match ($$$) { no strict 'refs'; my ($lhs, $rhs, $fun) = @_; my $locals = {}; # populate locals match_inner($lhs, $rhs, $locals); while (my ($k, $v) = each %$locals) { local ${$k} = $v; } return $fun->(); } sub match_inner { my ($lhs, $rhs, $locals) = @_; if (ref $lhs eq '') { $locals->{$lhs} = $rhs; } elsif (ref $lhs eq 'ARRAY') { if (@$lhs == @$rhs) { for my $i (0 .. $#$lhs) { match_inner($lhs->[$i], $rhs->[$i], $locals); } } } elsif (ref $lhs eq 'HASH') { if (same_keys($lhs,$rhs)) { for my $k (keys %$lhs) { match_inner($lhs->{$k}, $rhs->{$k}, $locals); } } } } match "bob", 45, sub { no strict; print $bob; };
count of USER UNIX groups
2 direct replies — Read more / Contribute
by Apronline
on Jan 24, 2015 at 21:57
    Hi, Can you please let me know how to find a count of USER UNIX groups in perl?

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 chanting in the Monastery: (18)
    As of 2015-01-26 17:51 GMT
    Find Nodes?
      Voting Booth?

      My top resolution in 2015 is:

      Results (195 votes), past polls