Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

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
Excel how to open existing worksheet
1 direct reply — Read more / Contribute
by AtlasFlame
on Jan 27, 2015 at 06:40

    How to write to existing worksheet?

    use Excel::Writer::XLSX; my $workbook = Excel::Writer::XLSX->new( 'sample.xlsx' ); $worksheet = $workbook->add_worksheet("new"); $worksheet->write(2, 2, 'Name'); $worksheet = $workbook->add_worksheet("old"); $worksheet->write(2, 2, 'Name'); $worksheet = $workbook->add_worksheet("latest"); $worksheet->write(2, 2, 'Name');

    How to open worksheet "new" for write again?

Prevent overidedirect from being always on top
1 direct reply — Read more / Contribute
by Anonymous Monk
on Jan 27, 2015 at 03:32
    Hi there monks

    The following issue disturbs me: I'm using overrideredirect to remove decorations and as a result the widget is always on top. This is usually fine, but sometimes I want to have a popup on top of the MW, but overrideredirect seems to always win. Is there anyway to make a window on top of an overrideredirect window? I've extended a famous example to emphasize the issue

    #!/usr/bin/perl -w use strict; use Tk; my $mw = tkinit; my $notification = $mw->Toplevel(); $notification->geometry('+400+400'); $notification->overrideredirect(1); # Remove window decorations $notification->withdraw; # Hide display window $notification->Label( -text => 'Your message displayed here.', -foreground => 'white', -background => 'black', -height => 5 )->pack; $notification->Button( -text => 'Press Me', -command => sub {my $msg = $mw->messageBox(-icon => 'error', -message => "No tests selected", -title => 'Error', -type => 'Ok', -default => 'Ok'); } )->pack; $mw->Button( -text => 'Display Notification Window', -command => \&display_note )->pack; MainLoop; sub display_note { $notification->deiconify; $notification->raise; # this is where you setup a condition to withdraw it $notification->after( 5000, \&hide_note ); } sub hide_note { $notification->withdraw; }
localtime function
4 direct replies — Read more / Contribute
by rsodhia
on Jan 27, 2015 at 02:57
    I have just started using perl, the first thing is on reading unixtimestamp values from file & converting them into standard format. I used localtime(). but with no luck
    #!/usr/bin/perl use strict; use warnings; use XML::CSV; use TEXT::CSV; use Time::Local; my @d; my %ha; my $file = 'dDos_flows.csv' or die $!; my $file1 = 'dDos_flows1.csv' or die $!; open(my $fh,'<:encoding(UTF-8)',$file); open(my $fh1,'>:encoding(UTF-8)',$file1); while(my $f=<$fh>) { chomp $f; my @data=split ",",$f; my $res=@data[2]; my @conv=scaler(localtime($data[2])); print "$conv[2]\n"; }
    $data2 has below output: startTime 1421744559358 1421744614728 1421744621032 1421724767767
Image-Magick on Strawberry Perl
3 direct replies — Read more / Contribute
by aplonis
on Jan 26, 2015 at 18:32

    Tried to install Image-Magick via PPM on Strawberry Perl. Got error message saying...

    Error installing package 'Image-Magick': Read a PPD for 'Image-Magick', but it is not intended for this build of Perl.

    ...and in parentheses it tells me which build I have. It does not tell me the build for which the PPD is intended so that I may instead install that (presumably older) version of Strawberry Perl.

    Any ready solutions?

array and string split
2 direct replies — Read more / Contribute
by numele
on Jan 26, 2015 at 18:13

    I have a piece of code that takes the output from a ssh command and puts it into an array. I could put it into a sting also and for this case I use both an array and a string. After I capture the output, I split the array or string on a \n and put the output of this into an array or another string. Next, run a foreach on the array or string and find the lines I need. There has to be a better way, if someone could give me some suggestions, I would appreciate it.

    ### start of code where I capture the command output $exp->send("show port\n"); $exp->expect(15, [ '# ', sub { my $self = shift; @port = $self->exp_before; }], ); foreach my $line (@port) { my @PORTS = split('\n', $line); foreach my $str (@PORTS){ if ($str =~ /^\d/) { $PORT_NO = (split /\s+/, $str) [0]; $exp->send("show port $PORT_NO detail\n"); $exp->expect(15, [ '# ', sub { my $self = shift; ### Here I use a string to cature the output $output_str = $self->exp_before; }], ); foreach my $string (split('\n', $output_str)){ chomp $string; if ($string =~ /Part Number/) { $model = (split /\s+/, $string) [3]; print "Node: $NODE_NAME,Port: $PORT_NO,Part: $mo +del\n"; } } } } }
[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.
5 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.

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 examining the Monastery: (11)
    As of 2015-01-27 12:52 GMT
    Find Nodes?
      Voting Booth?

      My top resolution in 2015 is:

      Results (200 votes), past polls