Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
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
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.

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

HMAC_MD5 with Net::SSH::Perl
1 direct reply — Read more / Contribute
by UpTide
on May 19, 2017 at 16:04

    On the main CPAN page http://search.cpan.org/~schwigon/Net-SSH-Perl/lib/Net/SSH/Perl.pm it says, and I quote "The deprecated hmac-sha1 or hmac-md5 algorithms are available but not enabled by default."
    Then It ends there. It does not say anything about how to enable sha1 or md5... I've been at this for hours trying to get it to use md5. I cannot use another SSH mac.
    The only thing I've found was Net::SSH::Perl::Mac, which just says it is implemented with Digest::HMAC_MD5, which just says 'This module provide HMAC-MD5 hashing.'
    I'm completely lost and very frustrated.


    EDIT: I found it finally. Example is as follows Net::SSH::Perl->new($serverHostname, debug => 1, options => ['MACs +hmac-sha1']) I was able to find this via the github page https://github.com/lkinley/Net-SSH-Perl found as the vague language "One can enable via the "MACs" option. For example: 'MACs +hmac-sha1'".
    I pray for those that have to also walk this path. Good luck.

'do' command is dead? Surely not?
1 direct reply — Read more / Contribute
by ACI
on May 19, 2017 at 09:57

    Hi there. This is infuriating me and I can't comprehend why it's happening. Best guess is that I've mangled the perl folder somehow. But re-installing the OS (Ubuntu Linux) doesn't help. Have I disabled something? Can I debug somehow? How can I find out why this is suddenly not working? Any assistance deeply appreciated!

    File: 'test.pl'

    print "Hello world!\n"; do 'test-response.pl'; print "Did that work?";
    File: 'test-response.pl' (same directory as 'test.pl')
    print "Hello Andy!\n";
    Output:
    Hello world! Did that work?

    Couldn't be simpler, surely? Done this a million times and never had a problem (unless my code has errors, which is not the problem here).

    Thanks in advance!

    Andy

printing every 2nd entry in a list backwards
7 direct replies — Read more / Contribute
by Anonymous Monk
on May 19, 2017 at 07:52

    Hallowed monks,

    lowly Perl apprentice here with a question regarding list traversal.

    I chanced upon this code written in a lesser language:

    import sys f = open(sys.argv[1], "r") for line in f: for n in line.split()[::-2]: sys.stdout.write(n + " ") print("");

    Being ever curious I wondered how this could be done in Perl.

    Trying to wield what little power of Perl I possess, I came up with the following:

    use strict; use warnings "all"; open(my $fh, "<", "$ARGV[0]") or die; while (<$fh>) { chomp; my $i = 0; map {print $i++ & 1 ? "" : "$_ "} reverse split(/ /); print "\n"; } close $fh;

    The task seems simple at a glance:

    Given a line of numbers from a file, print every 2nd number starting from the back.

    Example:

    1 22 3 -4 ==> -4 22

    Are the esteemed monks able to enlighten me with a solution that is better and more performant?

    Faithfully yours,

    Perl apprentice

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 all is quiet...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (5)
As of 2017-05-26 02:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?