Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris

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
Running perl scripts in parallel
3 direct replies — Read more / Contribute
by perl_help26
on Jul 23, 2014 at 10:48
    Hello ! I have two perl scripts : and that are supposed to run forever in parallel. Is it possible to call these scripts from a third perl script? i.e. ---------------------------- system('perl -w; system('perl -w;
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.

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
Install missing modules with Module::Extract::Install's cpanm-missing/cpanm-missing-deep
No replies — Read more | Post response
by frozenwithjoy
on Jul 24, 2014 at 12:07

    The other day I got a new laptop and tried to run a couple scripts on it. I quickly grew tired of the tedious cycle of 'Module::X not found' errors/installing Module::X. I decided to make a tool to improve the situation.

    The result, Module::Extract::Install, can be used to analyze perl scripts and modules to identify and install their dependencies in an automated, pain-free manner. You can use this module's methods to write your own script (e.g., to pipe missing modules to your favorite installer) or take advantage of the included command-line tools cpanm-missing (checks a list of Perl files) and cpanm-missing-deep (checks all the Perl files within a directory).

    Feel free to give me last minute comments/suggestions before I put it on CPAN (currently it is only available through GitHub). Thanks!

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

Log In?

What's my password?
Create A New User
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (6)
As of 2014-07-24 21:25 GMT
Find Nodes?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:

    Results (167 votes), past polls