Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

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
Calling a subroutine when part of call is a variable Contant
1 direct reply — Read more / Contribute
by Anonymous Monk
on May 26, 2017 at 18:13

    Dear Monks, Hoping you can help. I can call the subroutine first_name() like this:

    $self->xml()->first_name();

    However I want to call it when 'first_name' is a constant. The following code doesn't work

    use constant { STUFF => { 'name1' => 'first_name', 'name2' => 'last_name', }, }; foreach my $val (keys ${\( STUFF() ) } ){ my $value = eval("$self->xml()->${\( STUFF() ) }->{ $val }()"); }

    I can't use a code ref like below because of how it needs to be called ( perhaps there is a way? ) Note: I cannot use Readyonly either. I've also tried various combinations of \&{$variable} but can't seem to get it to work.

    use constant { STUFF => { 'name1' => $self->xml()->first_name(), 'name2' => $self->xml()->last_name(), }, };

    Please help if you can. Thanks

HTML::Parser / Regex
3 direct replies — Read more / Contribute
by MissPerl
on May 26, 2017 at 16:30
    Hi fellow Perl Monks,

    I am trying to get text/number in a html file then store them into a variable. I know that HTML::TableExtract or some other module might have easier way to do this. But for now, I want to learn and apply HTML::Parser and regex first.

    This is part of my failed attempt perl script, it got errors like bareword found (might be runaway multi-line) and can't use global $1 in my. At the beginning of the script, it prompt user for input then store them into a variable. For now, I am writing the part for the script to be able to reads the $ca html file and find match. Then next part of the script will continue for the other states' html file.

    use HMTL::Parser; my $ca = "california.html"; open (my $f1, "<" , $ca) || die ("Can't open file : california.html"); while (<$f1>){ if (my $text =~ /Employee\sA</th><th>.\d</){ my $one = $1; }elsif (my $text =~ /Employee\sB</th><th>.\d</){ my $two = $1; }elsif (my $text =~ /Employee\sC</th><th>.\d</){ my $three = $1; } } close ($f1);
    Below are a few lines from two different html files.
TCP Server: Beyond echoing request
2 direct replies — Read more / Contribute
by jeremywakeman
on May 25, 2017 at 10:03

    I'm building a TCP server to learn more about networking. What I have so far is based on various online examples: a server that responds to requests using a series of if, elsif, elsif attempts to match the request to an appropriate response.

    It seems like I should be looking to implement an application layer protocol to transfer data (text) between server and client, but I don't want to invent my own protocol or use one that's more complex than I need. Google searches have not resulted in a definitive answer. Is there an existing protocol I should look into?

    At the moment my client is just nc to the appropriate server port. I'm assuming I'll have to build a client if I implement an application level protocol

    #!/usr/bin/perl use warnings; use strict; use POSIX; use IO::Socket; use IO::Select; use Tie::RefHash; my $port = 1800; ### Create the server socket. my $server = IO::Socket::INET->new( LocalPort => $port, Listen => 10, ) or die "can't make server socket: $@\n"; $server->blocking(0); ### Set up structures to track input and output data. my %inbuffer = (); my %outbuffer = (); my %ready = (); tie %ready, "Tie::RefHash"; ### The select loop itself. my $select = IO::Select->new($server); while (1) { # Process sockets that are ready for reading. foreach my $client ($select->can_read(1)) { handle_read($client); } # Process any complete requests. Echo the data back to the client, # by putting the ready lines into the client's output buffer. foreach my $client (keys %ready) { foreach my $request (@{$ready{$client}}) { process_request($client,$request); } delete $ready{$client}; } # Process sockets that are ready for writing. foreach my $client ($select->can_write(1)) { handle_write($client); } } exit; sub process_request { my ($client,$request) = @_; print "Got request: $request"; chomp $request; if ( $request eq "HELLO" ) { $outbuffer{$client} .= "TEST SERVER 0.1\n"; } elsif ($request eq "GET NODES" ) { $outbuffer{$client} .= "NODES: 0 ZERO, 1 ONE, 2 TWO, 4 FOUR\n" +; } elsif ( $request =~ /^JOIN / ) { $outbuffer{$client} .= "JOINING NOT IMPLEMENTED\n"; } elsif ( $request =~ /^MSG / ) { $outbuffer{$client} .= "MSGING NOT IMPLEMENTED\n"; } else { $outbuffer{$client} .= "UNKNOWN COMMAND\n"; } } ### Handle a socket that's ready to be read from. sub handle_read { my $client = shift; # If it's the server socket, accept a new client connection. if ($client == $server) { my $new_client = $server->accept(); $new_client->blocking(0); $select->add($new_client); return; } # Read from an established client socket. my $data = ""; my $rv = $client->recv($data, POSIX::BUFSIZ, 0); # Handle socket errors. unless (defined($rv) and length($data)) { handle_error($client); return; } # Successful read. Buffer the data we got, and parse it into lines. # Place the lines into %ready, where they will be processed later. $inbuffer{$client} .= $data; while ($inbuffer{$client} =~ s/(.*\n)//) { push @{$ready{$client}}, $1; } } ### Handle a socket that's ready to be written to. sub handle_write { my $client = shift; # Skip this client if there's nothing to write. return unless exists $outbuffer{$client}; # Attempt to write pending data to the client. my $rv = $client->send($outbuffer{$client}, 0); unless (defined $rv) { warn "I was told I could write, but I can't.\n"; return; } # Successful write. Remove what was sent from the output buffer. if ( $rv == length($outbuffer{$client}) or $! == POSIX::EWOULDBLOCK) { substr($outbuffer{$client}, 0, $rv) = ""; delete $outbuffer{$client} unless length $outbuffer{$client}; return; } # Otherwise there was an error. handle_error($client); } ### Handle client errors. Clean up after the dead socket. sub handle_error { my $client = shift; delete $inbuffer{$client}; delete $outbuffer{$client}; delete $ready{$client}; $select->remove($client); close $client; }
Use CGI to run a Perl script via web server
5 direct replies — Read more / Contribute
by suvajit123
on May 25, 2017 at 07:07

    Hello Monks

    I have created a Perl script which runs fine manually with a value parsed during runtime, i.e. like 'perl myscript.pl value'

    I need to execute this over a Web Server (IBM HTTP Server), I have configured it correctly and it is able to execute the Hello_World.pl program to display Hello World with a name given as input in the URL. like https://hostname.com/cgi-bin/Hello_World.pl?name=test

    But my actual code which calls for a different Perl script from this, does not work.

    #!/usr/bin/perl use strict; use CGI; use IPC::System::Simple qw(system capture); #create CGI query object to get the SSO from URL my $sso = new CGI; my $sso = $query->param( "sso" ); #*********Script within a script both files in same path********** system( "perl myscript.pl $sso" ); print "Content-type:text/html\r\n\r\n"; print "<html>"; print "<head>"; print "<title>Some Header</title>"; print "</head>"; print "<body>"; print "<h2>You have entered $sso</h2>"; print "</body>"; print "</html>";

    This is not working as it is not detecting IPC::System::Simple qw(system capture) from this script. How could I make the CGI parse the $sso to myscript.pl ?

    Thanks in advance....

Tcl::Tk exit
2 direct replies — Read more / Contribute
by Sandy
on May 24, 2017 at 15:03
    Really silly question.

    I am used to Perl/Tk, with sample code that looks like

    use Tk; my $mw = MainWindow->new(-title=>"hello world"); $mw->Label(-text=>"hello")->pack(); $mw->Button(-text=>"Exit",-command=>sub{exit})->pack(); MainLoop;

    Now I am updating (?) to Tcl::Tk (because Perl/Tk requires Quartz on my Mac)

    use Tcl::Tk; my $int = new Tcl::Tk; my $mw = $int->mainwindow; $mw->Label( -text => "Hello World!" )->pack(); $mw->Button( -text => "Exit", -command => sub { exit } )->pack(); $int->MainLoop;

    But when I exit, I get the following error message (and a segmentation fault)

    perl5.18 quit unexpectedly while using the Tk plug-in.

    I have tried combinations of $mw->exit(), but that also doesn't work.

    Help.

XML-LibXML-2.0129 installation issues
2 direct replies — Read more / Contribute
by Brat
on May 24, 2017 at 10:44
    I installed the latest libxml perl library XML-LibXML-2.0129 after downloading it from cpan. my installation did not seem to have gone fine.
    perl Makefile.PL FORCE=1 PREFIX=/app/localapps/perl/lib LIB=/app/localapps/perl/lib enable native perl UTF8 running xml2-config...failed The installed version of libxml2 FORCED 2.9.4 is not compatible with XML::LibXML (and probably buggy)! You may continue at your own risk using 'perl Makefile.PL FORCE=1', bu +t: - don't expect XML::LibXML to build or work correctly! - don't report errors! - don't send patches! Check the README file for more information on versionsthat are tested +with XML::LibXML Checking for ability to link against xml2...yes Generating a Unix-style Makefile Writing Makefile for XML::LibXML Writing MYMETA.yml and MYMETA.json

    The issue with the installation is that I cannot find Node.pm. Not sure How I can fix this. Please help. what am I missing?

Parsing .txt into arrays
6 direct replies — Read more / Contribute
by Fshah
on May 24, 2017 at 05:32

    Hi there, I have a large log file in .txt format which has several pages (each page has different format,with different colums pertaining to different fields) I want to separate each column into an array so that it can be used to process later ,how do I do this I have a picture of how log file looks let me know if u need it, Thanks in advance

    place and year data: 67 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ |no.| name | age | place | year | |_ _|_ _ _ _|_ _ _ | _ _ _ | _ _ | |1 | sue |33 | NY | 2015 | |2 | mark |28 | cal | 2106 | work and language :65 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ |no.| name | languages | proficiency | time taken| |_ _| _ _ _| _ _ _ _ _ |_ _ _ _ _ _ _| _ _ _ _ _ | |1 | eliz | English | good | 24 hrs | |2 | susan| Spanish | good | 13 hrs | |3 | danny| Italian | decent | 21 hrs | Position log | | |Pos |value | |bulk|lot| prev| newest| |# |Locker|(dfg) |(no) |nul|val |Id | val |val | ----------------------------------------------------------- | 0| 1| 302832| -11.88| 1| 0|Pri| 16| 0| | 1| 9| 302836| 11.88| 9| 0|Pri| 10| 0| | 2| 1| 302832| -11.88| 5| 3|Pri| 14| 4| | 3| 3| 302833| 11.88| 1| 0|sec| 12| 0| | 4| 6| 302837| -11.88| 1| 0|Pri| 16| 3|

    I want these columns into an array with name as given in the table containing values as in the table. thank you.

Wildcards for a wide array of strings?
7 direct replies — Read more / Contribute
by zarath
on May 23, 2017 at 04:01
    Heyhey!

    Perl-virgin here, be gentle, pretty please with sugar on top. + English is not my native tongue, but i pride myself in my capabilities (in written English anyways, I sound a bit like a mix of a Frenchman and a German trying to speak American).

    I have a question about the very first script I'm trying to write.

    I'm sure this will be resolved in a jiffy by the first person who bothers to read this whole thing. Will you be that person?

why is the size of notebooks area smaller than main window
2 direct replies — Read more / Contribute
by madhusudhan_s
on May 22, 2017 at 00:49

    Hi,

    I am trying to write a program which has many notebooks and i found a reference code from the web as below which is exactly what i want. When i make the main window size 870x1000 i notice that the area where the notebooks are present is smaller than the main window. How should i modify this code such that the notebooks are as big as the main window?
    #!/usr/bin/perl use strict; use warnings; use Tk; use Tk::NoteBook; our $mw = MainWindow->new; $mw->geometry("870x1000"); my $canvas = $mw->Scrolled('Canvas',-bg=>'red')->pack; our $nb = $canvas->NoteBook; ### add 20 tabs to notebook for ( 1 .. 20 ){ my $title = "Untitled ($_)"; $nb->add( $_, -label => $title ); } ### embed the notebook widget into the canvas my $nb_in_canvas = $canvas->createWindow( 0,0,-window => $nb,-anchor = +> 'nw' ); $canvas->update; ### the whole notebook is larger than what can be initially displayed ### so we'll have to sroll it later on in the program $canvas->configure(-scrollregion => [0,0,$nb->reqwidth,$nb->reqheight] +); MainLoop;
John Guttag's book - 2nd exercise. My attempt in Perl.
12 direct replies — Read more / Contribute
by pritesh_ugrankar
on May 20, 2017 at 16:22

    Hi Monks,

    I came across John Guttag's book on computation - "Introduction to Computation and Programming Using Python". Note that I love Perl, but found this book to be very interesting. I tried the second finger exercise and though, initially it appeared trivial to solve, it took me a real long time to figure it out.

    Here's the exercise: Write a program that examines three variables— x , y , and z — and prints the largest odd number among them. If none of them are odd, it should print a message to that effect.

    Points to note:- This is to be tackled using only if/else loop and comparisons, because that is what the author has covered till that part.

    Here's my attempt in Perl. I tried other ways, but most of them would not print the expected results if either of the numbers were negative, or two of the three numbers were even.

    use strict; use warnings; my ($x, $y, $z) = (-11,-13,4); if ($x % 2 == 0 and $y % 2 == 0 and $z % 2 == 0) { print "All are even numbers\n"; } elsif ($x % 2 == 0 && $y % 2 == 0) { print "$z is the biggest odd number\n"; } elsif ($y % 2 == 0 && $z % 2 == 0) { print "$x is the biggest odd number\n"; } elsif ($x % 2 == 0 && $z % 2 == 0) { print "$y is the biggest odd number\n"; } elsif ($x % 2 == 0 && $y % 2 != 0 && $z % 2 != 0) { if ($y > $z) { print "$y is the greatest odd number\n"; } else { print "$z is the biggest odd number\n"; } } elsif ($y % 2 == 0 && $x % 2 != 0 && $z % 2 != 0) { if ($x > $z) { print "$x is the greatest odd number\n"; } else { print "$z is the biggest odd number\n"; } } elsif ($z % 2 == 0 && $x % 2 != 0 && $z % 2 != 0) { if ($x > $y) { print "$x is the greatest odd number\n"; } else { print "$y is the biggest odd number\n"; } } else { if ($x > $y && $x > $z) { print "$x is the biggest odd number\n"; } elsif ($y > $z) { print "$y is the biggest odd number\n"; } else { print "$z is the biggest odd number\n"; } }

    Update: As pointed out by Choroba, I did a typo at line 26. Sorry for the typo. I've fixed it below.

    use strict; use warnings; my ($x, $y, $z) = (-11,-13,-17); if ($x % 2 == 0 and $y % 2 == 0 and $z % 2 == 0) { print "All are even numbers\n"; } elsif ($x % 2 == 0 && $y % 2 == 0) { print "$z is the biggest odd number\n"; } elsif ($y % 2 == 0 && $z % 2 == 0) { print "$x is the biggest odd number\n"; } elsif ($x % 2 == 0 && $z % 2 == 0) { print "$y is the biggest odd number\n"; } elsif ($x % 2 == 0 && $y % 2 != 0 && $z % 2 != 0) { if ($y > $z) { print "$y is the greatest odd number\n"; } else { print "$z is the biggest odd number\n"; } } elsif ($y % 2 == 0 && $x % 2 != 0 && $z % 2 != 0) { if ($x > $z) { print "$x is the greatest odd number\n"; } else { print "$z is the biggest odd number\n"; } } elsif ($z % 2 == 0 && $x % 2 != 0 && $z % 2 != 0) { if ($x > $z) { print "$x is the greatest odd number\n"; } else { print "$z is the biggest odd number\n"; } } else { if ($x > $y && $x > $z) { print "$x is the biggest odd number\n"; } elsif ($y > $z) { print "$y is the biggest odd number\n"; } else { print "$z is the biggest odd number\n"; } }

    While this works fine for all the test cases I tried, but I will be thankful if you could please let me know a better way of writing this. Point to note is, it should only use if/else/elsif loops and / or comparison operators.


Empty STDIN does not exit while loop
6 direct replies — Read more / Contribute
by Anonymous Monk
on May 20, 2017 at 03:31

    Ok, it's not a huge issue and has an easy workaround, but I'm curious as to why this does not work. I want to break out of the while loop if an empty string is entered to STDIN. Am I missing something obvious due to sleep deprivation or lack of caffeine?

    print " > "; while (chomp( my $line = <STDIN>)){ print " [$line]\n"; } print " > ";

    I'm not looking for a solution, I already have that. Just wondering why this doesn't work

New Meditations
How easy it is to make mistakes
4 direct replies — Read more / Contribute
by tobyink
on May 23, 2017 at 06:54

    So, I don't use CGI a lot much these days. But I recently wrote a little joke module and decided to make a little HTML form interface for it. Plack would be a sensible way of doing the interface, but this was just a silly little thing and I was feeling lazy, so I coded it up using CGI instead. I'd used Moo rather than Moose so speed shouldn't have been an issue.

    I uploaded it to the server and visited the page and it just showed me my Perl source code. Hmmm…

    Create .htacccess and add the following lines:

    Options +ExecCGI AddHandler cgi-script .cgi .pl

    Visit the page again… still showing the source code. Hmmm…

    Scratch head for five minutes. Open up httpd.conf, add:

    <Directory /path/to/my/vhost/> AllowOverride all </Directory>

    Visit the page again… still showing the source code. Hmmm…

    SSH into the server and run ./myscript.cgi from the command line.

    "uniq" is not exported by the List::Util module

    Okay, I must have an old version of it. Upgrade.

    Visit the page again… still showing the source code. Hmmm…

    Stop using List::Util entirely.

    sub uniq { my %seen; grep !$seen{$_}++, @_; }

    Visit the page again… still showing the source code. Hmmm…

    Scratch head for ten minutes. Rename to ./myscript.pl.

    Visit the page again… still showing the source code. Hmmm…

    Create the following file and mark it as executable:

    #!/bin/sh echo "Content-Type: text/plain"; echo ""; echo "Hello world";

    Visit my new page… also showing the source code. Hmmm…

    Scratch head some more.

    Consider buying anti-headlice shampoo.

    Finally… FINALLY… after about TWO HOURS I figure out the problem! It was…

Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and monks are getting baked in the sun...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (6)
As of 2017-05-26 23:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?