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

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
Firefox/Javascript/Perl CGI argument passing issue
4 direct replies — Read more / Contribute
by beckmanel
on Jul 22, 2014 at 10:40

    I'm using CGI::Application::Dispatch on the Perl backend

    Data is sent from Javascript:

    88 var _factories = [ 89 function() { return new XMLHttpRequest(); }, 90 function() { return new ActiveXObject("Msxml2.XMLHTTP"); } +, 91 function() { return new ActiveXObject("Microsoft.XMLHTTP") +; } 92 ]; 93 94 var _factory = null; 95 96 function newRequest() { 97 if (_factory != null) return _factory(); 98 99 for(var i = 0; i < _factories.length; i++) { 100 try { 101 var factory = _factories[i]; 102 var request = factory(); 103 if (request != null) { 104 _factory = factory; 105 return request; 106 } 107 } 108 catch(e) { 109 continue; 110 } 111 } 112 _factory = function() { 113 throw new Error("XMLHttpRequest not supported"); 114 } 115 _factory(); 116 } 1233 var http_request; 1234 http_request = newRequest(); 1252 var query = "ip=" + document.getElementById('ip').value; 1253'POST', "/", t +rue); 1254 http_request.send(query); 1255 return false;

    But when I do the same action from the same web page, but different browsers, I get parameters in a different form through Perl CGI (see below). My code has been working with the IE form, can I do anything to make the Firefox output form similar ?

    THANKS Much in advance.

    The below was generated in the target Perl procedure by:

    print STDERR "QUERY: ", Dumper($self->query), "\n";

    FIREFOX 15202 [Tue Jul 22 08:55:55 2014] [error] [client] QUERY: + $VAR1 = bless( {, referer: 15203 [Tue Jul 22 08:55:55 2014] [error] [client] + '.parameters' => [, referer: 15204 [Tue Jul 22 08:55:55 2014] [error] [client] + 'POSTDATA', referer: http://56.207.201. +210:8083/ 15205 [Tue Jul 22 08:55:55 2014] [error] [client] + ],, referer: 15206 [Tue Jul 22 08:55:55 2014] [error] [client] + '.charset' => 'ISO-8859-1',, referer: +0:8083/ 15207 [Tue Jul 22 08:55:55 2014] [error] [client] + 'POSTDATA' => [, referer: 15208 [Tue Jul 22 08:55:55 2014] [error] [client] + 'ip=', referer: http://56.207. +201.210:8083/ 15209 [Tue Jul 22 08:55:55 2014] [error] [client] + ],, referer: 15210 [Tue Jul 22 08:55:55 2014] [error] [client] + '.fieldnames' => {},, referer: 15211 [Tue Jul 22 08:55:55 2014] [error] [client] + 'escape' => 1, referer: 15212 [Tue Jul 22 08:55:55 2014] [error] [client] + }, 'CGI' );, referer: 15213 [Tue Jul 22 08:55:55 2014] [error] [client] , refe +rer: 15214 [Tue Jul 22 08:55:55 2014] [error] [client] [Tue J +ul 22 08:55:55 2014] Use of uninitialized value in pattern +match (m//) at /var/www/smartncm_test_ie11/lib/OpenNCMApp/EntryPoint. +pm line 896., referer: 15215 [Tue Jul 22 08:55:55 2014] [error] [client] [Tue J +ul 22 08:55:55 2014] Use of uninitialized value in pattern +match (m//) at /var/www/smartncm_test_ie11/lib/OpenNCMApp/EntryPoint. +pm line 897., referer: IE 15332 [Tue Jul 22 08:58:58 2014] [error] [client] QUERY: + $VAR1 = bless( {, referer: 15333 [Tue Jul 22 08:58:58 2014] [error] [client] + '.parameters' => [, referer: 15334 [Tue Jul 22 08:58:58 2014] [error] [client] + 'ip', referer: +83/# 15335 [Tue Jul 22 08:58:58 2014] [error] [client] + ],, referer: 15336 [Tue Jul 22 08:58:58 2014] [error] [client] + '.charset' => 'ISO-8859-1',, referer: +0:8083/# 15337 [Tue Jul 22 08:58:58 2014] [error] [client] + 'ip' => [, referer: 15338 [Tue Jul 22 08:58:58 2014] [error] [client] + '', referer: +083/# 15339 [Tue Jul 22 08:58:58 2014] [error] [client] + ],, referer: 15340 [Tue Jul 22 08:58:58 2014] [error] [client] + '.fieldnames' => {},, referer: +# 15341 [Tue Jul 22 08:58:58 2014] [error] [client] + 'escape' => 1, referer: 15342 [Tue Jul 22 08:58:58 2014] [error] [client] + }, 'CGI' );, referer: 15343 [Tue Jul 22 08:58:58 2014] [error] [client] , refe +rer:
print package's symble table
4 direct replies — Read more / Contribute
by vinoth.ree
on Jul 22, 2014 at 04:06

    Hi Monks,

    I was doing somthing wrong, pls help me on this.

    I was trying to print the symble table of a package of mine.below is my package code

    package Vinoth; use strict; use warnings; use Data::Dumper; our $VERSION=1.0; sub printSimbleTable{ my $package = shift; print "I am in printSimbleTable of : $package\n"; print Dumper \%$packge::; #Not working print Dumper \%Vinoth::; # Works #print Dumper \%{$packge}::; #Not working # foreach my $varName (sort keys %$package::) # { # print "$varName\n"; # local *typeglob = %{$package}::{$varName}; # print "$$varName\n" if ($typeglob); # } } 1;

    I tried to use this package in a perl script and calling a function in this module to print the package's symble table. Below is the script file

    use strict; use warnings; use Vinoth; &Vinoth::printSimbleTable( 'Vinoth' );

    As you can see this line print Dumper \%$packge::; #Not working the $package hash my module name 'Vinoth', but its not printing the symble table with the Dumper, when I replace it with the my module name explicity, it works. how to use $package variable here and make it work ?


    Packages and Symbol Tables

    A package's namespace is a symbol table. The name of your package is stored in a hash named after your package with two colons appended to it. If you name a package BushWhack, its symbol table name is %BushWhack::. Packages are represented as %main:: or %:: in the symbol table by default. Since we're dealing with a hash, each key must have a value. Because keys are identifiers, values are the corresponding typeglob values; globs are pretty efficient because they do the symbol table lookups at compile-time. In other words, *BushWhack represents the value of %BushWhack::--see the following:

    local *low_flyer = *BushWhack::variable; # compile time local *low_flyer = *BushWhack::{"variable"}; # run time

    You can look up all the keys and variables of a package with this example. You may use undef() on these to clear their memory, and they will be reported as undefined. You shouldn't undefine anything here unless you don't plan to load these packages again. Because the memory has already been filled, it saves time when you load them if you leave them defined:1

    foreach $symbol_name (sort keys %BushWhack::) { local *local_sym = $BushWhack::{$symbol_name}; print "\$$symbol_name is defined\n" if($local_sym); print "\@$symbol_name is defined\n" if(@local_sym); print "\%$symbol_name is defined\n" if(%sym); }

    All is well
Bizarre Dancer encoding behavior
3 direct replies — Read more / Contribute
by xyzzy
on Jul 20, 2014 at 21:25

    Short version: When using return to send a response, Dancer converts a Unicode string into ISO8859-1. When setting the content directly via the Dancer::Response->new() method, the response contains the correct string.

    Long version: I have an extremely minimal Dancer app. At some point, I was going to expand it to do a lot more, but as of right now the only thing it does is return the currently-playing track of an MPD server running on the same machine. A static page with an HTML5 internet radio player sends a request and updates a "Now Playing:" span at regular intervals. I needed something quick and dirty without mucking about with the two MPD modules on CPAN, so I used a system call. For those unfamiliar with MPD, it is a music player with a server-client architecture. There are a plethora of clients available for all different platforms, but the most basic is a CLI client called mpc. Called with no arguments, it returns the server status:

    xyzzy@asscat:~$ mpc
    ДДТ - Чёрно-белые танцы
    [playing] #27/31 1:21/6:03 (21%)
    volume: n/a repeat: off random: off single: off consume: off

    Here's the first version:

    get '/np' => sub { return `mpd | head -n1`; }

    Simple enough. But instead of the Unicode, my span looks like this:

    Now playing: ””Т - Ч‘€но-бел‹е ‚а톋

    I spent an hour trying to enable utf8, checking the HTTP headers, the meta tags on the page, even using Encode, but nothing worked. Then I rewrote my handler like so:

    get '/np' => sub { Dancer::Response->new( status => 200, content => `mpd | head -n1`, ); }


    Now playing: ДДТ - Чёрно-белые танцы

    Most of me only cares that it works now. But part of me is still baffled why one way works and the other way doesn't. What is it about return that mangles the sting encoding? It has to be something inherent in Dancer, because if I do

    xyzzy@asscat:~$ perl -e'sub a {return `mpc|head -n1`}print a'
    ДДТ - Герой

    it works perfectly fine. Does anyone here know enough about Dancer's internals or is clever enough to figure this out?

    $,=qq.\n.;print q.\/\/____\/.,q./\ \ / / \\.,q.    /_/__.,q..
    Happy, sober, smart: pick two.
Win32 GUI onDrag?
2 direct replies — Read more / Contribute
by AndreaN
on Jul 20, 2014 at 11:26


    I'm currently creating an application in which I use the onDropFiles event of Win32::GUI.

    I wanted the icon of the button to change when the user is dragging the file on it. I looked in the documentation but I didn't find any event like a "onDraggedFile" or anything similar. Has anybody found this problem? Did I miss something or is it just impossible to change icon in this way using Win32::Gui?


[OneLiner] What am I doing wrong in my regex?
1 direct reply — Read more / Contribute
by three18ti
on Jul 18, 2014 at 15:57

    Hello Monks

    I had to bump the version in a number of files; as it was too many to do by hand I thought I could handle it in a oneliner.

    Spoiler alert: I did get it worked out with a oneliner (at the end), but I'm flummoxed to no end as to why my first attempt was not working. Can anyone give me any clues to what I was doing wrong?

    Here are my wrong initial attempts (and their output), the first one is probably the most puzzling, if $version is undef, where did "version '1.2.36'" come from?!?:

    printf "foo\nversion '1.2.36'\nbaz\n" | perl -MData::Dumper -pi -e " +next unless /version/; ($version) = /version\s+('1\.2\.36')/; print $ +version" foo version '1.2.36' version '1.2.36' baz printf "foo\nversion '1.2.36'\nbaz\n" | perl -MData::Dumper -pi -e " +next unless /version/; ($version) = /version\s+('1\.2\.36')/; print D +umper $version" foo version '1.2.36' baz printf "foo\nversion '1.2.36'\nbaz\n" | perl -MData::Dumper -pi -e " +next unless /version/; ($version) = /version\s+('1\.2\.36')/; print D +umper \$version" foo $VAR1 = undef; version '1.2.36' baz printf "foo\nversion '1.2.36'\nbaz\n" | perl -pi -e 'next unless /ve +rsion/; ($version) = $_ =~ m{ version \s+ ''(1[.]2[.]36)'' }xms; prin +t "version:" . $version . "\n"' foo version: version '1.2.36' baz

    Now of course, doing this in a script works:

    $ cat #!/usr/bin/perl use 5.010; use strict; use warnings; while (<>) { next unless /version/; my ($version) = /version \s+ '(\d+[.]\d+[.]\d+)'/msx; say $version; } $ printf "foo\nversion '1.2.36'\nbaz\n" | perl 1.2.36

    Epilogue: I did get it figured out, first of all, I only needed to change the last decimal point, so really I only needed to capture the last decimal point. I'm at a loss as to why this one works and my version was unable to match... (but I solved my problem so the issue is at least out of the way) (credit goes to my coworker)

    printf "foo\nversion '1.2.36'\nbaz\n" | perl -pi -e 'if ($_ =~ m/ver +sion\s+.\d+[.]\d+[.](\d+)/) { my $v1 = quotemeta $1; my $v2 = $1 + 1; + $_ =~ s/$v1/$v2/ }' foo version '1.2.37' baz

    I appreciate any insight that may help me avoid obvious mistakes in the future (although I've driven myself up a wall trying to find any "obvious" mistakes...)


reading a value out of a program
3 direct replies — Read more / Contribute
by State_Space
on Jul 18, 2014 at 10:15

    I'm currently opening a file using

     my $status = system($file);

    This opens the file in the program that it's created in. Inside that program's window is the files window. I need to access a tab of that window. Then copy a value in a table on that tab. Also I can't access the file without the program it's encrypted.

    I don't want to name the program, but a good analogy would opening an excel file using system. Accessing the second tab of the file and reading E12 cell.

    My background is in EE and I'm PERL beginner. I don't know what to do after the files been opened. If there is a CPAN Module that can read objects or manipulate them. Any help would be appreciated.

Massive expansion of a hash of arrays?
6 direct replies — Read more / Contribute
by Amblikai
on Jul 17, 2014 at 16:42

    Hi Monks! I've got a bit of a question which i'm hoping could make one of my scripts a bit more concise

    Essentially i have a hash of arrays (massively simplified):

    my %hash=('ID' => { 'key1' => [key1_val1, key1_val2], 'key2' => [key2_val1, key2_val2] } );

    And i need to expand it out to look like this:

    ID, 1, key1_val1, key2_val1 ID, 2, key1_val1, key2_val2 ID, 3, key1_val2, key2_val1 ID, 4, key1_val2, key2_val2

    So each key is a field of data With various values and i need to expand out a single line for each combination given. As i said, this i massively simplified and i actually have ~15 'keys' and each can have about 11-12 values in it's array.

    I'm currently doing it the obvious way of:

    my $id2=1; my %data=(); foreach my $id (keys(%hash)) { foreach my $key1_val (@{$hash{$id}{'key1'}}) { foreach my $key2_val (@{$hash{$id}{'key2'}}) { $id2++; $data{$id}{$id2}{'key1'}=$key1_val; $data{$id}{$id2}{'key2'}=$key2_val; } } }

    Which is fine but everytime i add a new field it get a bit unwieldy. I have "foreach" statements running off the side of the monitor and onto my wall!! Help!

    Apologies if there's any mistakes in the above. It's been a long day. Any help appreciated as ever!

FTP script suddenly not working from crontab
2 direct replies — Read more / Contribute
by joetesta
on Jul 17, 2014 at 14:38

    We have a script we've been using (launched from crontab) for several years to upload images using Net::FTP. Recently we began to notice problems where the images were not uploading and errors were appearing in the logs.

    In troubleshooting, I've found that presently the program works just fine when launched from cmd line, but when launched from crontab it errors consistently. On the remote server, I can see in the FTP log that the connection is still active, the client is changing directories but the STOR command never appears as it does under normal circumstance. On the client side, when the ftp->put is issued, the response appears to be '227 Entering Passive Mode'

    I've tried everything I can think of to track down the cause (firewalls, ephemeral ports, memory leaks) but so far my only solution is to run it manually from the cmd line.

    Does anyone have any idea what might be the cause of this problem? tyvmia

Malformed UTF-8 character error after fetching data from Postgresql
3 direct replies — Read more / Contribute
by nihiliath
on Jul 17, 2014 at 11:01

    Hello, Monks

    I have this problem:

    I have a script fetching some data from a Postgresql database.

    The database server encoding is UTF-8, and the script is in cp1251 (windows-1251). After connecting to the database (using DBI) I set the database client encoding to WIN1251, so to tell the database that I want the output to be in this encoding. Then I execute the SQL select query and I fetch the data in a hash reference. When I try to dump the data into the console(or just use it in any other way) I get this warning / error:

    Malformed UTF-8 character (unexpected non-continuation byte 0x2e, immediately after start byte 0xf2) in subroutine entry at /usr/local/lib/perl5/5.16/mach/Data/ line 205.

    The reason that we use windows-1251 as code encoding is because it's legacy code and we have data in cyrrilic. The database is in UTF8 because we hope that we'll rewrite the code in the future in UTF8...

    Can someone tell me why this is happening and how to avoid it?!

    I'm using:

    FreeBSD 9.2-STABLE #2 r265059 Perl v5.16.3 Postgresql 9.1.13 DBI v1.631 DBD::Pg v3.0.0

    My locale settings:


    My database locale:

    Name | Owner | Encoding | Collate | Ctype | ----------------+---------+----------+--------------+--------------+ database_name | yavor | UTF8 | C | C |

    My script:

    Result from execution:

    Default Client Encoding: $VAR1 = { 'client_encoding' => 'UTF8' }; Current Client Encoding: $VAR1 = { 'client_encoding' => 'WIN1251' }; Malformed UTF-8 character (unexpected non-continuation byte 0xee, imme +diately after start byte 0xd1) in subroutine entry at /usr/local/lib/ +perl5/5.16/mach/Data/ line 205. ... Malformed UTF-8 character (1 byte, need 4, after start byte 0xf2) in s +ubroutine entry at /usr/local/lib/perl5/5.16/mach/Data/ line + 205. ... Data: $VAR1 = { '<proper ouput>' => { 'descr_en' => '', 'descr_bg' => '<proper output in the console in cyrri +llic>', 'id' => <proper output>, 'name_en' => '<proper output>', 'host' => '<proper output>' },
Bioinformatics, Error: explicit package name
6 direct replies — Read more / Contribute
by mlsmit10
on Jul 17, 2014 at 10:08

    I'm working on a script that will take a genome and cut it at two restriction sites. The original script gave me the numbers of size fragments flanked by these two cut sites that would be produced. Now, I am trying to add a third restriction enzyme and exclude from the final counts any fragments containing this cut site. I've tried using grep to exclude such fragments, but am running into one problem I can't figure out.

    This is the portion of the code I have altered: (for the rest of the code, see the end of the post)
    my @third_fragments = grep -v ($rsite3), $second_fragments[$i] my @final_fragment1 = $seqname."_".$i."_1"; my @final_fragment2 = $seqname."_".$i."_2"; $final_fragments{$final_fragment1} = $third_fragments[0]; $final_fragments{$final_fragment2} = $third_fragments[scalar @ +third_fragments - 1];

    I receive the following error message when I try to run the code:

    syntax error at /Users/smithcabinets26/Desktop/RAD/Digester/Improving/ line 68, near "my " Global symbol "@final_fragment1" requires explicit package name at /Us +ers/smithcabinets26/Desktop/RAD/Digester/Improving/MyTripleDigester-3 line 68. Global symbol "$final_fragment1" requires explicit package name at /Us +ers/smithcabinets26/Desktop/RAD/Digester/Improving/MyTripleDigester-3 line 70. Global symbol "$final_fragment2" requires explicit package name at /Us +ers/smithcabinets26/Desktop/RAD/Digester/Improving/MyTripleDigester-3 line 71. Execution of /Users/smithcabinets26/Desktop/RAD/Digester/Improving/MyT aborted due to compilation errors.
    Here is the complete code:

    My apologies if the answer is obvious or the question is posed poorly. I'm new to coding, and I haven't been able to solve this by looking at previous posts. Thanks for the help.

    Problem solved! Thanks for all the help, everyone. After I fixed the semicolon issue, I played around with the grep function a bit (which I now see some of you suggested), and was able to get the script up and running. In case anyone else has a similar situation where they want to use grep in this way, the modifications I made to the grep line are included below (I've only included the one line, and it should just replace the grep line in the above code). The script now does exactly what I wanted it to do. Again, thanks for the help!

    my @third_fragments = grep !/$rsite3/, $second_fragments[$i];
Perl in a multi-platform environment
3 direct replies — Read more / Contribute
by lowcoordination
on Jul 17, 2014 at 09:15
    Hey everyone! I have inherited a new project where we want to migrate some existing perl and shell scripts that our admin team uses for user maintenance purposes into a web based platform. Examples of the functionality would be add/remove user accounts, add/remove groups to user accounts, create/remove groups, password resets, etc. We have AIX, Solaris, and Linux servers in the environment and I was wondering how you go about setting up a system to service all these different flavors of unix. What have you implemented in the past? what was the general methodology used? that sort of thing... Cheers!
output to STDERR/warn hangs Perl under Apache at ~64,800 bytes
2 direct replies — Read more / Contribute
by RockyMtn
on Jul 16, 2014 at 20:31

    We found a CGI script that called 'warn' too many times would hang the Perl process running under Apache (separate process). When you kill the process, the Apache error log then gets the first 648 calls to warn, but no more. This does not happen from the command line, nor running in the Eclipse CGI debugger (which doesn't use Apache).

    The same thing happens if we merely print to STDOUT 1000 times; it hangs on 649 (based on browser stdout). 100 bytes per call * 648 = 64,800 bytes. (100 more bytes shouldn't be over 64*1024=65536 yet.)

    Any ideas please?

    env details:

  • Apache on windows (httpd-2.2.22-win32-x86-openssl-0.9.8t)
  • Perl v5.18.2 ( MSWin32-x86-multi-thread-64int - ActiveState)
  • Apache is running locally, writing to C:
  • You can try this with:

    #!C:\perl\bin\perl.exe use strict; select( STDERR ); $| = 1; select( STDOUT ); $| = 1; print <<HTML_HEADER; Content-type: text/plain <HTML> <head> <title></title> </head> <body style='background-color:#cccccc'> HTML_HEADER # Write to stdout lot of times... for ( my $lineNumber = 1; $lineNumber <= 1000; $lineNumber++ ) { print "$lineNumber...<br>\n"; my $errMsg = substr( "Line $lineNumber....." x 10, 0, 99) . "\n"; print STDERR $errMsg; #called 649, writes 648x successfully; + 648*100=64,800; 64*1024=65536 #warn( $errMsg); #called 649, write 648x successfully } print <<HTML_TRAILER; </body> </HTML> HTML_TRAILER
    Any help is appreciated.
New Meditations
The problem with "The Problem with Threads"
3 direct replies — Read more / Contribute
by BrowserUk
on Jul 18, 2014 at 07:26

    This started life as a reply to Re^2: Which 'Perl6'? (And where?), but it seems too important to bury it down there in a long dead thread as a reply to an author I promised to resist, and whom probably will not respond. So I'm putting it here to see what of any interest it arouses.

    1. Is concurrency appropriate? There are two basic motivations ... and 2) to speed things up. In the latter case, if the problem being tackled is really IO bound, turning to concurrency probably won't help.

      That is way too simplistic a view. If the problem is IO bound to a single, local, harddisk, and is uncacheable, then concurrency may not help.

      But change any of the four defining elements of that criteria; and it might -- even: probably will -- be helped by well written asynchronicity. Eg.

      1. If the IO data is, or can be, spread across multiple local physical drives; concurrency can speed overall throughput by overlapping requests to different units.
      2. If the disks are remote -- as in SAN, NAS, cloud etc. -- then again, overlapping requests can increase throughput by utilising buffering and waiting time for processing.
      3. If the drives aren't harddisks, but SSDs; or SSD buffered HDs; or PCI connected virtual drives; then overlapping several fast read requests with each slower write request can more fully utilise the available bandwidth and improve throughput.
      4. If the IO involved displays temporal locality of reference -- that is, if the nature of the processing is such that a subset of the data has multiple references over a short period of time, even if that subset changes over the longer term -- then suspending the IO for new references until re-references to existing cached data play out comes about naturally if fine-grained concurrency is used.

      And if some or all of the IO in your IO bound processing is to the network, or network attached devices; or the intranet; or the internet; or the cloud; -- eg. webserving; webcrawling; webscraping; collaborative datasets; email; SMS; customer facing; ....... -- then both:

      • Preventing IO from freezing your processing;
      • And allowing threads of execution who's IO has completed to continue as soon as a core is available -- ie. not also have to wait for any particular core to become available;

      Is mandatory for effective utilisation of modern hardware and networks; even for IO-bound processing.

      Only kernel(OS) threading provides the required combination of facilities. Cooperative multitasking (aka. 'green threads'; aka. Win95 tech) simply does not scale beyond the single core/single thread hardware of the last century.

    2. The Problem with Threads.

      The problem with "The Problem with Threads", is that it is just so much academic hot air divorced from the realities of the real world.

      Only mathematicians and computer scientists demand total determinacy; and throw their arms up in refusal to work if they don't get it.

      The rest of the world -- you, me, mothers and toddlers, doctors, lawyers, spacemen, dustmen, pilots, builders, shippers, movers & shakers, factory workers, engineers, tinkers, tailors, soldiers, sailors, rich & poor men, beggars and thieves; all have to live in the real -- asynchronous -- world, where shit happens.

      Deliveries are late; machines break down; people are sick; power-outs and system-downs occur; the inconvenient realities of life have to be accepted, lived with and dealt with.

      The problem is not that threading is hard; the problem is that people keep on saying that "threading is hard"; and then stopping there.

      Man is very adept at dealing with hard and complex tasks

      Imagine all places you'd never have been; all the things you'd never have done; if the once wide-spread belief that we would suffocate if we attempted to travel at over 30mph.

      Too trivial an example for you? Ok. Think about heart transplantation. Think about the problems of disconnecting and reconnecting the (fragile, living) large bore pipes supplying and removing the pumped liquid; the wires carrying electrical control signals; the small bore pipes carrying the lubricants needed to keep the pump alive and removing the waste. Now think about the complexities of doing a pump change whilst keeping the engine running; the passengers comfortable and the 'life force' intact. And all the while contending with all the other problems of compatibility; rejection; infection; compounded diagnosis.

      Circa. 5000 coronary transplants occurred last year. Mankind is good at doing difficult things.

      Asynchronicity and non-determinism are 'solved problems' in almost every other walk of life

      From multiple checkouts in supermarkets; to holding patterns in the skies above airport hubs; to off & on ramps on motorways; to holding tanks in petro-chemical plants; to waiting areas in airports and doctors and dentists surgeries; to carousels in baggage claims and production lines; distribution warehouses in supply chains; roundabouts and filter-in-turn; {Add the first 10 things that spring to your mind here! }.

      One day in the near future a non-indoctrinated mathematician is going to invent a symbol for an asynchronous queue.

      She'll give it a nice, technical sounding name like "Temporally Lax Composer", which will quickly become lost behind the cute acronym and new era of deterministic, asynchronous composability will ensue.

      And the academic world will rejoice, proclaim her a genius of our time, and no doubt award her a Nobel prize. (That'd be nice!)

      And suddenly the mathematicians will realise that a process or system of processes can be deterministic, without the requirement for every stage of the process (equation) to occur in temporal lockstep.

      'Safety' is the laudable imperative of the modern era.

      As in code-safety and thread-safety, but also every other kind of predictable, potentially preventable danger.

      Like piety, chastity & sobriety from bygone eras, it is hard to argue against; but the world is full (and getting fuller) of sexually promiscuous atheists who enjoy a drink; that hold down jobs, raise kids and perform charitable works. The world didn't fall apart with the wane of the religious, moral and sobriety campaigns of the past.

      In an ideal world, all corners would be rounded; flat surfaces 'soft-touch'; voltages would be low; gases non-toxic; hot water wouldn't scald; radiant elements wouldn't sear; microwaves would be confined to lead-lined bunkers; there'd be no naked flames; and every home would be fire-proof, flood-proof, hurricane-proof, tornado-proof, earthquake-proof, tsunami-proof and pestilence-proof.

      Meanwhile in the real-world, walk around your own house and see all the dangers that lurk for the unsupervised, uneducated, unwary, careless or stupid and ask yourself why do they persist? Practicality and economics.

      Theoreticians love theoretical problems; and eschew practical solutions.

      When considering concurrency, mathematicians love to invent ever so slightly more (theoretically) efficient solutions to the 'classical' problems.

      Eg. The Dining Philosophers. In a nutshell: how can 6 fil..Phillo.. guys eat their dinners using 5 forks without one or more of them starving. They'll combine locks and syncs, barriers and signals, mutexs and spinlocks and semaphores trying to claw back some tiny percentage of a quasilinear factor.

      Why? Buy another bloody fork; or use a spoon; or eat with your damn fingers.

      The problem is said to represent the situation where you have 6 computers that need to concurrently use the scarce resource of 5 tape machines. But that's dumb!

      Its not a resource problem but a capital expenditure problem. Buy another damn tape machine and save yourself 10 times its cost by avoiding having to code and maintain a complex solution. Better still, buy two extra tape machines; cos as sure as eggs is eggs, it'll be the year-end accounting run; or the Black Friday consumer spending peak when one of those tape machines defy the 3 sigma MTBF and break.

      Threading can be complex, but there are solutions to all of the problems all around us in the every day, unreliable, non-deterministic operations of every day modern life.

      And the simplest solution to many of them is to avoid creating problems in the first place. Don't synchronise (unless you absolutely have to). Don't lock (unless it is absolutely unavoidable). Don't share (unless avoiding doing so creates greater problems).

      But equally, don't throw the baby out with the bath water. Flames are dangerous; but oh so very useful.

    3. Futures et al are the future. There are much simpler, safer, higher level ways to do concurrency. I haven't tried Paul Evans' Futures, but they look the part.

      And therein lies the very crux of the problem. Most of those decrying threads; and those offering alternative to them; either haven't tried them -- because they read they were hard -- or did try them on the wrong problems, and/or using the wrong techniques; and without taking the time to become familiar with and understand their requirements and limitations.

      Futures neither remove the complexity nor solve the problems; they just bury them under the covers forcing everyone to rely upon the efficacy of their implementation and the competence of the implementors.

      And the people making the decisions are taking advice from those thread-shy novices with silver bullets and employing those with proven track records of being completely useless at implementing threaded solutions.

      The blind taking advice from the dumb and employing the incompetent.

    4. Perl 5 "threads" are very heavy. This sometimes introduces additional complexity.

      The "heaviness" of P5 threading is a misnomer. The threads aren't heavy; the implementation of shared memory is heavy. And that could easily be fixed. If there was any interest. If there wasn't an institutionalised prejudicial barrier preventing anyone even suggesting change to improve the threading support; much less supporting those with the knowledge and ideas to take them forward.

      They've basically stagnated for the past 8 or more years because p5p won't allow change.

    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
New Cool Uses for Perl
SysV shared memory (Look-Alike) -- pure perl
3 direct replies — Read more / Contribute
by flexvault
on Jul 20, 2014 at 16:42

    Dear Monks,

    I have stayed away from using shared memory because of the statement: "This function is available only on machines supporting System V IPC." in the documentation for use. I decided I had a good use and did a Super Search and found zentara's excellent work which I used as a starting point for this discussion. I re-read the documentation and looked at the books 'Programming Perl' and the 'Perl Cookbook', and wondered if I could do something similar with a RAM disk and not have a dependency on System V IPC support. So taking the code provided by zentara, and using it as a benchmark for my requirements, I started testing on a 8GB RAM disk on a Debian 64bit Linux box using a 32-bit 5.14.2 Perl. I found that I could get approximately 216K System V IPC writes per second(wps). WOW!

    Since I only needed 20-25K writes per second, I started working on my "shared memory look-alike". What I found was that I could do better than 349K wps. Actually the 1st run produced 800K wps, but I realized I didn't follow the format of zentara's script, so I modified the script to call a subroutine, flock the file, test return codes, etc. Currently, 349K wps is the worse case on a RAM disk, 291K wps on a 7,200 rpm hard disk, and 221K wps on a 5,400 rpm disk. (Note: I didn't have a SSD on the test system.) The code follows, and if I did something to make my numbers look better, I'd like to know.

    Update: Do not use this code as it mixes buffered and unbuffered I/O. See later for a sample that I believe works correctly!

    ####### ############################ #!/usr/bin/perl use warnings; use strict; use Time::HiRes qw( gettimeofday usleep ); use Fcntl qw( :DEFAULT :flock ); ## Part of core perl use IPC::SysV qw(IPC_STAT IPC_PRIVATE IPC_CREAT IPC_EXCL S_IRUSR S_IWU +SR IPC_RMID); # see "perldoc perlfunc /shmget" and "perldoc perlipc /SysV" # big difference from c is attach and detach is automatic in Perl # it attaches to read or write, then detaches my $go = 1; $SIG{INT} = sub{ $go = 0; &close_m(); #close up the shared mem exit; }; my $segment_hbytes = 0x640; # hex bytes, a multiple of 4k my ($segment_id, $segment_size) = &init_m($segment_hbytes); print "shmid-> $segment_id\tsize-> $segment_size\n"; # Counter Elap +sed time Writes/second # ------------- +---------------------------- my $stime = gettimeofday; my $i = 0; # Result: 2000000 9.27 +134203910828 215718/second while($go) { &write_m($i); $i++; if ( $i >= 2_000_000 ) { $stime = gettimeofday - $stime; my $rpm = int( 2_000_000 / + $stime ); print "$i\t$stime\t$rpm/second\n\n"; last; } #select(undef,undef,undef,.001); last if ! $go; } our $indexdb; # Counter Ela +psed time Writes/second # ------------ +----------------------------- my $file = "/dev/shm/FlexBase/__env.index"; # Result: 2000000 5.7 +3024797439575 349025/second # my $file = "/__env.index"; # Result: 2000000 6.8 +8051080703735 290676/second # my $file = "/flexvault/__env.index"; # Result: 2000000 9.0 +2671384811401 221564/second open( $indexdb,"+<", $file ) or die "Not open: $!"; $stime = gettimeofday; $i = 0; while( 1 ) { &write_mem($i); $i++; if ( $i >= 2_000_000 ) { $stime = gettimeofday - $stime; my $rpm = int( 2_000_000 / + $stime ); print "$i\t$stime\t$rpm/second\n"; last; } } close $indexdb; exit; sub write_mem() { our $indexdb; # Write a string to the shared file. my $message = shift; if ( flock( $indexdb, LOCK_EX ) ) { my $ret = sysseek( $indexdb, 0, 0); # move to beginning of fil +e if ( ! defined $ret ) { die "O04. sysseek failed: $!"; } $ret = syswrite ( $indexdb, $i, length($i) ); if ( $ret != length($i) ) { die "O05. syswrite failed! $!"; } } ## ## Make test ( 1==1 ) to verify syswrite worked correctly. ## Make test ( 1==2 ) to test speed of syswrite to filesystem. ## if ( ( 1==2 )&&( flock( $indexdb, LOCK_SH ) ) ) { my $ret = sysseek( $indexdb, 0, 0); # move to beginning of fil +e if ( ! defined $ret ) { die "O06. sysseek failed: $!"; } $ret = sysread ( $indexdb, my $ni, length($i) ); if ( $ni != $i ) { die "O07. |$ni|$i| $!"; } } return 0; } ################################################################# sub init_m(){ my $segment_hbytes = shift; # Allocate a shared memory segment. my $segment_id = shmget (IPC_PRIVATE, $segment_hbytes, IPC_CREAT | IPC_EXCL | S_IRUSR | S_IWUSR); # Verify the segment's size. my $shmbuffer = ''; shmctl ($segment_id, IPC_STAT, $shmbuffer); my @mdata = unpack("i*",$shmbuffer); #not sure if that is right unp +ack? works :-) return($segment_id, $mdata[9] ); } sub write_m() { # Write a string to the shared memory segment. my $message = shift; shmwrite($segment_id, $message, 0, $segment_size) || die "$!"; #the 0, $segment_size can be broke up into substrings like 0,60 # or 61,195, etc return 0; } sub close_m(){ # Deallocate the shared memory segment. shmctl ($segment_id, IPC_RMID, 0); return 0; } 1; __END__


    "Well done is better than well said." - Benjamin Franklin

Yahoo Content Analyzer
No replies — Read more | Post response
by Your Mother
on Jul 20, 2014 at 16:34

    Inspired by How to transmit text to Yahoo Content Analysis. Not sure how complete or correct it is, just threw it together for fun. Seems to work and Ill make amendments as necessary or sanely suggested.

    Requires: strictures, LWP::UserAgent, Getopt::Long, Pod::Usage, Path::Tiny.

    #!/usr/bin/env perl use 5.010; use strictures; no warnings "uninitialized"; use LWP::UserAgent; use Getopt::Long; use Pod::Usage; use open qw( :encoding(UTF-8) :std ); use Path::Tiny; # use XML::LibXML; # For expansion... or XML::Rabbit my $service = ""; my %opt = ( text => undef, url => undef, max => 100 ); # These are, luckily, false by default for Yahoo, so we only care abou +t true. my %boolean = map {; $_ => 1 } qw/ related_entities show_metadata enable_categorizer /; # What we compose to query, e.g. not "verbose" or "file." my %sql = ( %opt, %boolean ); my $ok = GetOptions( \%opt, "text=s", "file=s", "url=s", "max=i", "verbose", "help", keys %boolean ); pod2usage( -verbose => 0, -exitval => 1, -message => "Options were not recognized." ) unless $ok; pod2usage( -verbose => 2 ) if $opt{help}; pod2usage( -verbose => 0, -exitval => 1, -message => "One of these, at most, allowed: text, url, fil +e." ) if 1 < grep defined, @opt{qw/ text url file /}; # Only one, text|file, is allowed by Getopt::Long. $opt{text} ||= path($opt{file})->slurp if $opt{file}; unless ( $opt{url} || $opt{text} ) # Accept from STDIN. { say "Type away. ^D to execute (on *nix anyway)."; chomp( my @input = <> ); $opt{text} = join " ", @input; die "Give some input!\n" unless $opt{text} =~ /\w/; } my @where; for my $key ( keys %opt ) { next unless defined $opt{$key} and exists $sql{$key}; $opt{$key} = "true" if $boolean{$key}; $opt{$key} =~ s/([\\"'\0])/\\$1/g; push @where, sprintf "%s = '%s'", $key, $opt{$key}; } my $q = sprintf "SELECT * FROM contentanalysis.analyze WHERE %s", join " AND ", @where; say "SQL >> $q\n" if $opt{verbose}; my $ua = LWP::UserAgent->new; my $response = $ua->post( $service, [ q => $q ] ); say $response->request->as_string if $opt{verbose}; say $opt{verbose} ? $response->as_string : $response->decoded_content(); exit ! $response->is_success; __END__ =pod =encoding utf8 =head1 Name yahoo-content-analyzer - command-line to query it. =head1 Synopsis yahoo-content-analyzer -text "Perl is a programming language." -text "{command line string}" -file (slurp and submit as text) -url -max [100 is default] -related_entities -show_metadata -enable_categorizer -verbose -help =head1 Description L<> =head1 Code Repository L<> =head1 See Also L<>. =head1 Author and License Your Mother, L<>. You may redistribute and modify this code under the same terms as Perl itself. =head1 Disclaimer of Warranty No warranty. No means no. =cut


    • Removed URI, only first draft used it.
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 chilling in the Monastery: (12)
As of 2014-07-23 16:36 GMT
Find Nodes?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:

    Results (147 votes), past polls