Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
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
Understanding Inline::C to call vendor libraries
1 direct reply — Read more / Contribute
by murrayn
on Jul 25, 2014 at 02:31
    I have installed and successfully tested Inline::C with a simple "Hello World" and vowel counter (from the Inline::C Cookbook) so I'm reasonably happy that the installation is correct. I now want to invoke a vendor's C written API from Perl. The vendor's sample C code includes the line: #define SHLIBNAME dptcpiphi.dll My Perl code includes the following in order to access (I pray) the functions which I expect to be contained in dptcpiphi.dll:
    use Inline C => Config => AUTO_WRAP => ENABLE; use Inline C => Config => LIBS => '-L"C:\Program Files\Common Files\Pr +oduct\4.1\dptcpiphi.dll" -ldptcpip';
    The full Perl script is short:
    #!/usr/bin/perl -w use Inline C => Config => AUTO_WRAP => ENABLE; use Inline C => Config => LIBS => '-L"C:\Program Files\Common Files\Pr +oduct\4.1\dptcpiphi.dll" -ldptcpip'; use Inline C => DATA ; use strict; my $DPbuff = "statusbuffer"; my $status = MyGetCtrlStatus('0x14','localhost','1703',$DPbuff); print "$status\n"; __END__ __C__ int MyGetCtrlStatus(char ShiftCmd, char pHostName, char uPortNum, char + pCtrlStatus) { char JobInfo; int status = DPGetCtrlStatus(ShiftCmd, pHostName, uPortNum, pCtrlS +tatus); printf ("Running...\n"); return pHostName; }
    The gcc compile step appears to complete successfully but when it comes time to link the object libraries together it fails:
    Test_pl_5261.o:Test_pl_5261.c:(.text+0x27): undefined reference to `DP +GetCtrlStatus' collect2: ld returned 1 exit status dmake.exe: Error code 129, while making 'blib\arch\auto\Test_pl_5261\ +Test_pl_5261.dll'
    (I know the code isn't going to work at present but I can fix that as long as I can get Inline::C to link the vendor libraries into my Perl script.) Have I completely misinterpreted the purpose and capabilities of Include::C or simply made a mess of using the tool?
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 : perlscript1.pl and perlscript2.pl that are supposed to run forever in parallel. Is it possible to call these scripts from a third perl script? i.e.
    perlscript3.pl ---------------------------- system('perl -w perlscript1.pl); system('perl -w perlscript2.pl);
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 http_request.open('POST', "/index.pl/get_neigh_display", 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 56.80.2.131] QUERY: + $VAR1 = bless( {, referer: http://56.207.201.210:8083/ 15203 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] + '.parameters' => [, referer: http://56.207.201.210:8083/ 15204 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] + 'POSTDATA', referer: http://56.207.201. +210:8083/ 15205 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] + ],, referer: http://56.207.201.210:8083/ 15206 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] + '.charset' => 'ISO-8859-1',, referer: http://56.207.201.21 +0:8083/ 15207 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] + 'POSTDATA' => [, referer: http://56.207.201.210:8083/ 15208 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] + 'ip=56.97.243.16', referer: http://56.207. +201.210:8083/ 15209 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] + ],, referer: http://56.207.201.210:8083/ 15210 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] + '.fieldnames' => {},, referer: http://56.207.201.210:8083/ 15211 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] + 'escape' => 1, referer: http://56.207.201.210:8083/ 15212 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] + }, 'CGI' );, referer: http://56.207.201.210:8083/ 15213 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] , refe +rer: http://56.207.201.210:8083/ 15214 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] [Tue J +ul 22 08:55:55 2014] index.pl: Use of uninitialized value in pattern +match (m//) at /var/www/smartncm_test_ie11/lib/OpenNCMApp/EntryPoint. +pm line 896., referer: http://56.207.201.210:8083/ 15215 [Tue Jul 22 08:55:55 2014] [error] [client 56.80.2.131] [Tue J +ul 22 08:55:55 2014] index.pl: Use of uninitialized value in pattern +match (m//) at /var/www/smartncm_test_ie11/lib/OpenNCMApp/EntryPoint. +pm line 897., referer: http://56.207.201.210:8083/ IE 15332 [Tue Jul 22 08:58:58 2014] [error] [client 56.80.2.131] QUERY: + $VAR1 = bless( {, referer: http://56.207.201.210:8083/# 15333 [Tue Jul 22 08:58:58 2014] [error] [client 56.80.2.131] + '.parameters' => [, referer: http://56.207.201.210:8083/# 15334 [Tue Jul 22 08:58:58 2014] [error] [client 56.80.2.131] + 'ip', referer: http://56.207.201.210:80 +83/# 15335 [Tue Jul 22 08:58:58 2014] [error] [client 56.80.2.131] + ],, referer: http://56.207.201.210:8083/# 15336 [Tue Jul 22 08:58:58 2014] [error] [client 56.80.2.131] + '.charset' => 'ISO-8859-1',, referer: http://56.207.201.21 +0:8083/# 15337 [Tue Jul 22 08:58:58 2014] [error] [client 56.80.2.131] + 'ip' => [, referer: http://56.207.201.210:8083/# 15338 [Tue Jul 22 08:58:58 2014] [error] [client 56.80.2.131] + '56.97.243.16', referer: http://56.207.201.210:8 +083/# 15339 [Tue Jul 22 08:58:58 2014] [error] [client 56.80.2.131] + ],, referer: http://56.207.201.210:8083/# 15340 [Tue Jul 22 08:58:58 2014] [error] [client 56.80.2.131] + '.fieldnames' => {},, referer: http://56.207.201.210:8083/ +# 15341 [Tue Jul 22 08:58:58 2014] [error] [client 56.80.2.131] + 'escape' => 1, referer: http://56.207.201.210:8083/# 15342 [Tue Jul 22 08:58:58 2014] [error] [client 56.80.2.131] + }, 'CGI' );, referer: http://56.207.201.210:8083/# 15343 [Tue Jul 22 08:58:58 2014] [error] [client 56.80.2.131] , refe +rer: http://56.207.201.210:8083/#
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 ?

    Reference:

    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
    xyzzy@asscat:~$

    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`, ); }

    Suddenly:

    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

    Hello,

    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?

    Thanks!

[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 wtf.pl #!/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 wtf.pl 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...)

    Thanks!

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

    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 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!

    ####### shmem-init.pl ############################ #!/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__

    Regards...Ed

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

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (12)
As of 2014-07-25 12:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (171 votes), past polls