Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
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
Polygon Creation -- Request for Algorithm Suggestions
4 direct replies — Read more / Contribute
by golux
on Nov 22, 2017 at 14:13
    I'm working on a "hobby" Perl project in my spare time, where I want to take a set of points and order them so as to define the enclosing polygon. Ultimately this will be used in a web page (for shapes representing towns in different counties) presented using the <area shape="poly" coords="..."> tag.

    I've abstracted what I have so far into a short test program "test.pl":

    I'm happy with my prune_interior_points method, which takes the initial set of points and discards all but the outline of the shape (both of which you can see by running the script "test.pl".

    The final step will be to order the points in such a way that no two consecutive points have too much distance between them, but still using ALL of the points, so as to produce a polygon. The distance algorithm for any two points is, of course, sqrt(($y1 - $y0) ** 2 + sqrt($x1 - $x0) ** 2), but I'm getting stuck on finding a simple algorthm for producing this ordering.

    Does anyone have any suggestions for such an algorithm?

    Edit: It occurs I could have made this a Meditation, since it's more about discussing algorithms than it is about a specific Perl question.

    say  substr+lc crypt(qw $i3 SI$),4,5
Win32::OLE Excel temporary objects destruction
5 direct replies — Read more / Contribute
by ndts
on Nov 22, 2017 at 08:42

    Hello PerlMonks,

    I have inherited from another person some Perl scripts dealing with logfile manipulation. The idea is simple, read data from some text file, decode it and write the results in an Excel file. The script is working ok, but it takes a huge amount of time to finish, even though the log files are not that big (30MB max). Moreover, the script runs 10x faster on my colleague machine. I use Win32::OLE to deal with Excel manipulation as I also need to do some formatting on the output.

    To find out which parts of the code are slow I have done a profiling of my application using Devel::NYTProf and I have found some interesting results. A snippet of the code is the following:

    $Excel = Win32::OLE->GetActiveObject('Excel.Application') || Win32::OL +E->new('Excel.Application', 'Quit'); $Book = $Excel->Workbooks->Open( $templateFile ); # #decoding code here # $Book->Worksheets($sheetNumber)->Range("A$Row:E$Row")->{Value} = [[$Ti +meAbs,$TimeRel,$TimeLog,$Info,$SigValue]];

    The NYTProf output for the last line of code shows something like:

      "# spent 35.5s making 44688 calls to Win32::OLE::AUTOLOAD, avg 794Ás/call"

    and a few lines below:

      "# spent 454s making 22344 calls to Win32::OLE::DESTROY, avg 20.3ms/call"

    What I want to understand is why the AUTOLOAD function is called here? (Moreover why it is called 2 times every time the line is passed(the line is called 22344 times). Could this be related to the fact that I use Win32::OLE on a configuration on 64bits (both Windows and Excel)? Also, why is the destructor so time expensive and why is it called every time the line is executed? I suppose that some temporary objects are created there but I do not have enough experience with Win32::OLE to figure it out.

    Any suggestions, hints, tutorials are welcome. Thanks.

    Sebi

5.26 and prebuilt libraries on Windows
1 direct reply — Read more / Contribute
by Marc-Philip
on Nov 21, 2017 at 10:29
    Hi, I'm trying to build perl 5.26.1 from source on Windows using the Visual Studio 2010 on a 64bit machine:
    1. edit win32/Makefile to set CCTYPE=MSVC100
    2. run vcvarsall.bat amd64 to open a command shell with the development environment
    3. cwd with that shell to the win32 folder
    4. run nmake

    This succeeds. Now I want to buildáthe Compress::Raw:Zlib extension, that comes with the perl tarball, against my prebuilt zlib. To do this, one needs to set the environment variables ZLIB_LIB and ZLIB_INCLUDE to the folders that contain zlib.lib resp. zlib.h and BUILD_ZLIB to "False". When I run nmake now, I get this error:

    link -out:..\..\lib\auto\Compress\Raw\Zlib\Zlib.dll -dll -nolo +go -nodefaultlib -debug -opt:ref,icf -ltcg -libpath:"c:\perl\lib\COR +E" -machine:AMD64 Zlib.obj "..\..\lib\CORE\perl526.lib" "C:\SAPDev +elop\hmexternals\perl\import\content\src_zlib-1.2.11-sap7-ntamd64.tar +.gz\zlib-1.2.11-sap7-ntamd64-release-msvc2010\lib\zlib.lib" "c:\Progr +am Files (x86)\Microsoft Visual Studio 10.0\VC\\lib\oldnames.lib" "c: +\Program Files (x86)\Microsoft SDKs\Windows\v7.0A\lib\x64\kernel32.li +b" "c:\Program Files (x86)\Microsoft SDKs\Windows\v7.0A\lib\x64\user3 +2.lib" "c:\Program Files (x86)\Microsoft SDKs\Windows\v7.0A\lib\x64\g +di32.lib" "c:\Program Files (x86)\Microsoft SDKs\Windows\v7.0A\lib\x6 +4\winspool.lib" "c:\Program Files (x86)\Microsoft SDKs\Windows\v7.0A\ +lib\x64\comdlg32.lib" "c:\Program Files(x86)\Microsoft SDKs\Windows\v +7.0A\lib\x64\advapi32.lib" "c:\Program Files (x86)\Microsoft SDKs\Win +dows\v7.0A\lib\x64\shell32.lib" "c:\Program Files (x86)\Microsoft SDK +s\Windows\v7.0A\lib\x64\ole32.lib" "c:\Program Files (x86)\Microsoft +SDKs\Windows\v7.0A\lib\x64\oleaut32.lib" "c:\Program Files (x86)\Micr +osoft SDKs\Windows\v7.0A\lib\x64\netapi32.lib" "c:\Program Files (x86 +)\Microsoft SDKs\Windows\v7.0A\lib\x64\uuid.lib" "c:\Program Files (x +86)\Microsoft SDKs\Windows\v7.0A\lib\x64\ws2_32.lib" "c:\Program File +s (x86)\Microsoft SDKs\Windows\v7.0A\lib\x64\mpr.lib" "c:\Program Fil +es (x86)\Microsoft SDKs\Windows\v7.0A\lib\x64\winmm.lib" "c:\Program +Files (x86)\Microsoft SDKs\Windows\v7.0A\lib\x64\version.lib" "c:\Pro +gram Files (x86)\Microsoft SDKs\Windows\v7.0A\lib\x64\odbc32.lib" "c: +\Program Files (x86)\Microsoft SDKs\Windows\v7.0A\lib\x64\odbccp32.li +b" "c:\Program Files (x86)\Microsoft SDKs\Windows\v7.0A\lib\x64\comct +l32.lib" "c:\Program Files (x86)\Microsoft Visual Studio 10.0\VC\\lib +\msvcrt.lib" -def:Zlib.def Creating library ..\..\lib\auto\Compress\Raw\Zlib\Zlib.lib and obje +ct ..\..\lib\auto\Compress\Raw\Zlib\Zlib.exp Zlib.obj : error LNK2001: unresolved external symbol __security_check_ +cookie Zlib.obj : error LNK2001: unresolved external symbol memcpy zlib.lib(inflate.obj) : error LNK2001: unresolved external symbol memc +py zlib.lib(deflate.obj) : error LNK2001: unresolved external symbol memc +py zlib.lib(trees.obj) : error LNK2001: unresolved external symbol memcpy Zlib.obj : error LNK2001: unresolved external symbol __imp_memmove Zlib.obj : error LNK2001: unresolved external symbol memcmp Zlib.obj : error LNK2001: unresolved external symbol strlen Zlib.obj : error LNK2001: unresolved external symbol __imp__errno Zlib.obj : error LNK2001: unresolved external symbol __imp_printf Zlib.obj : error LNK2001: unresolved external symbol memset zlib.lib(deflate.obj) : error LNK2001: unresolved external symbol mems +et LINK : error LNK2001: unresolved external symbol _DllMainCRTStartup zlib.lib(zutil.obj) : error LNK2001: unresolved external symbol __imp_ +malloc zlib.lib(zutil.obj) : error LNK2001: unresolved external symbol __imp_ +free ..\..\lib\auto\Compress\Raw\Zlib\Zlib.dll : fatal error LNK1120: 11 un +resolved externals NMAKE : fatal error U1077: '"c:\Program Files (x86)\Microsoft Visual S +tudio 10.0\VC\BIN\amd64\link.EXE"' : return code '0x460' Stop.

    The problem is that the path to msvcrt.lib is wrong. It uses c:\Program Files (x86)\Microsoft Visual Studio 10.0\VC\\lib\msvcrt.lib, but there's the amd64 part missing. The correct path is C:\Program Files (x86)\Microsoft Visual Studio 10.0\VC\lib\amd64\msvcrt.lib. Please note the missing amd64 is NOT where there's a double backslash.

    Compiling against the very same prebuilt zlib with the very same procedure works in perl 5.24.1. I suspect a problem in perl 5.26.1. I've noticed that libpth in Config_heavy.pl in 5.26.1 is libpth='"c:\Program Files (x86)\Microsoft Visual Studio 10.0\VC\\lib"', where it's libpth='\lib' in perl 5.24.1.

    Does anyone have an idea? Please note that

    • this is not a problem of the Compress:Raw:Zlib extensions, but of the perl itself.
    • Compress::Raw::Zlib has a problem on Windows as well (https://rt.cpan.org/Ticket/Display.html?id=123699)

    Thanks and Regards Marc-Philip

Loading a part of the file to array using Tie::File
8 direct replies — Read more / Contribute
by ansh007
on Nov 21, 2017 at 09:44

    I am extremely new to perl and working on my 1st perl code. I am stuck at a point, where I need to read a part of a file using Tie::File;

    My Old code:
    open(LOG_READ,"cat $InLogFilePath|tail -n +$InStartLineNumber|") || di +e "can not open file :$!"; my @all_lines = <LOG_READ> ; close (LOG_READ); for (@all_lines) {.. }

    But this could eat a lot of memory, as the files are huge. So I found Tie::File online, that happens not to load arrays in memory. 1st question, is that correct ?

    If yes, I get:

     tie @array, 'Tie::File', $filename or die ...;

    But I do not want to read the whole file. Let's say I want to read from line number 100 till end. How do I do it, using Tie::File ? something similar to:

    tie @array, 'Tie::File', "cat $InLogFilePath|tail -n +$InStartLineNumber" or die ...;

    Looking forward to your help monks :)

"indir" in shebang line
3 direct replies — Read more / Contribute
by ForgotPasswordAgain
on Nov 21, 2017 at 04:28
    In perlrun, it mentions:
    If the #! line does not contain the word "perl" nor the word "indir", the program named after the #! is executed instead of the Perl interpreter.
    I found with git that "indir" support was added in a cleanup commit for Perl 5.0 in 1994 and was mentioned in perlrun in 2012. Just out of curiousity, what is "indir" referring to?
perl6 rational number problem
2 direct replies — Read more / Contribute
by freakcoco
on Nov 20, 2017 at 23:14
    Hi Monk, I love perl6 number, it use rationals number by defulat.
    But how about large number? can I use it by default?
    some code like that:
    my Rat @example =  1 , * ** 0.9999 ... Inf;
    This work fine on  @example[^4]
    But when the number going bigger , it will stored float point by default and type check fail.
    How can i fix that?



    fixed question: Addition 、 Subtraction 、Multiplication 、 Division 、 Modulo
    my Rat @ex01 = 1.0 , * + 0.9999 ... Inf; my Rat @ex02 = 1.0 , * - 0.9999 ... Inf; my Rat @ex03 = 1.0 , * * 0.9999 ... Inf; my Rat @ex04 = 1.0 , * / 0.9999 ... Inf; my Rat @ex05 = 1.0 , * % 0.9999 ... Inf; my %ex = :add(@ex01), :substrat(@ex02), :mult(@ex03), div(@ex04), mod(@ex05); try { for < add substrat mult div mod > -> $op { for 1 .. 20 -> $count { .say; (%ex{$op})[$count] } } }
    This try will fail in Multiplication and Division
    Why?
    How to fix it?
Perl, Android web app, AJAX, JSON
3 direct replies — Read more / Contribute
by monx663
on Nov 20, 2017 at 17:49
    Hi all

    This is not a 100% Perl question but I am Perl programmer and my question touches on Perl heavily. There is a fully functional web based CMS that is written in Perl for which I would like to make certain functionality available to an Android app being written. The requirements are not that "heavy".

    The Android App needs to do the following few things:

    * Send a username/password combination to gain access to the CMS backoffice.

    * Call certain URLs which will enable the app to get a list of objects (images,names, other table contents) available in the CMS's database.

    * Probably POST to certain URLs in order to be able to upload images and create content.

    My question is: What methodology/APIs should I be looking at to complete this Perl CMS/Android app "integration". I was thinking of writing an AJAX layer that would expose certain methods to the Android app, which will be calling them via HTTP requests. I was also thinking of modifying certain of the CMS's packages to perhaps implement methods for JSON based communication of textual and binary data (images). I have also heard of Mojolistic, which supposedly is intended for writing RESTful APIs but find this a bit of an overkill for my scenario.

    Does anybody want to offer any of his thoughts about which route to pursue?

Extracting embedded file from PDF
1 direct reply — Read more / Contribute
by staszeko
on Nov 20, 2017 at 17:36
    I need to extract XML file embedded in PDF. I looked into module 'CAM::PDF' by Chris Dolan, but I could not find suitable examples. I need to do the extraction as part of a larger Perl program, without calls to third party tools like 'pdfdetach' or 'pdftk'. I would much appreciate any suggestion that could help me to achieve this task. Below is fragment of dictionary, returned by method 'getRootDict()'; you can see the name of XML file referenced there:
    $VAR1 = { 'Type' => bless( { 'gennum' => 0, 'value' => 'Catalog', 'type' => 'label', 'objnum' => 83 }, 'CAM::PDF::Node' ), 'Names' => bless( { 'gennum' => 0, 'value' => { 'EmbeddedFiles' => bless( { + 'gennum' => 0, + 'value' => { + 'Names' => bless( { + 'gennum' => 0, + 'value' => [ + bless( { + 'gennum' => 0 +, + 'value' => 'Z +UGFeRD-invoice.xml', + 'type' => 'st +ring', + 'objnum' => 8 +3 + }, 'CAM::PDF::N +ode' ),
hashref with(out) arrays
9 direct replies — Read more / Contribute
by bfdi533
on Nov 20, 2017 at 17:36

    I have some XML that is being returned from a REST API and sometimes there is a single result and sometime there are multiple results.

    I am having a hard time determining how to get the data that I need and know if there is an array or not. Example:

    $item->{result}->[0]->{value} $item->{result}->[1]->{value}
    versus
    $item->{result}->{value}

    I really need to get the value if there is one or know there are more than one value so I can collect them into an array.

    What is the best practice for this sort of thing?

    Update:

    I have been using XML::Simple so far with my code and I do find that it is inconsistent and hard to work with. I will be trying out XML::Rules here shortly per your generous recommendations.

Perl an array of sockets
2 direct replies — Read more / Contribute
by suhijo
on Nov 20, 2017 at 13:42

    I have two problems, first I need to open a websocket and register each socket into a struct so when an event from Asterisk AMI occurs, send some message to each one of the connected sockets from my @users array but when I open the socket and send the message the connection close.

    Second problem is I cannot receive data after websocket is open, a javascript code sends a simple string and I don't know how to open it, instead I receive html headers if I print $data inside sub incoming. Something I must be doing wrong.

    I have tried using other libraries, like Net::WebSocket::Server or Net::WebSocket::EV but doesn't suit me well, first one never return after start and second have no idea how to catch the ip, port, etc.

    Here is the code, it is a test, not fancy or anything just testing if the solution is possible

    use IO::Socket; use EV; use Data::Dumper; use Asterisk::AMI; use Digest::SHA1 qw(sha1 sha1_hex sha1_base64); use Encode qw(decode encode); use threads; use threads::shared; use warnings; $| = 1; my $connection_count = 0; my $h; my $fh; our @users : shared; my $astman = Asterisk::AMI->new(PeerAddr => '127.0.0.1', PeerPort => '5038', Username => 'admin', Secret => 'emel1t0', Events => 'on', Handlers => { default => \&eventhandler } ); die "Unable to connect to asterisk" unless ($astman); sub eventhandler { my ($ami, $event) = @_; if($event->{'Event'} eq "Dial"){ if($event->{'SubEvent'} eq "Begin"){ print "inicio,$event->{'CallerIDNum'},$event->{'Connect +edLineName'},$event->{'UniqueID'}\n"; buscar_exten(10000); } if($event->{'SubEvent'} eq "End"){ print "Fin,$event->{'UniqueID'},$event->{'DialStatus'}\ +n"; } } } my $server = new IO::Socket::INET(LocalPort => 50080, Type => SOCK_STR +EAM,Listen => SOMAXCONN, Reuse => 1, Proto => 'tcp'); my $w = EV::io $server, EV::READ, \&incoming; EV::loop; sub incoming { my $w=shift; $fh=$w->fh->accept or die; my $fileno = fileno $fh; push (@users, $fileno); my $cladd=$fh->peerhost(); my $clport=$fh->peerport(); my $claddr=$fh->peeraddr(); print "cladd: $cladd clport :$clport claddr:\n"; printf "$cladd: new socket connection #%d (%d)\n", ++$connection +_count, +scalar keys %$h; $fh->recv($data, 1024); $data =~ /Sec-WebSocket-Key: (\S+)/; $str = $1; print "key is1 $str|\n"; my $str = sha1_base64($str . "258EAFA5-E914-47DA-95CA-C5AB0D +C85B11"); send($fh, qq{HTTP/1.1 101 Switching Protocols\r\nConnection: + Upgrade\r\nUpgrade: websocket\r\nSec-Websocket-Accept: $str=\r\n\r\n +}, 0); $h->{$fh} = EV::io $fh, EV::READ, \&cliente; } sub cliente { my $c=shift; my $fh2=$c->fh; my $bytes_read=sysread($fh2, my $bytes, 9_999_999); return if (not exists $h->{$fh}); if (($bytes eq 'q') || ($bytes_read == 0)) { close($fh2); undef $c; delete $h->{$fh2}; printf "socket connection terminated by %s (%d (%d) sockets ++remaining)\n", $bytes_read == 0 ? 'peer' : 'server', --$connection_c +ount, scalar keys %$h; } } sub buscar_exten{ $exten=$_[0]; print "buscando si <$exten> esta logueada-\n"; foreach my $b (@users) { open my $c, ">&=$b" ; send($c,"mandando mensaje 1000\r\n",0); } print "}\n"; }
cpan client problem with strawberry portable
1 direct reply — Read more / Contribute
by Discipulus
on Nov 20, 2017 at 07:46
    Hello monks and nuns,

    before submitting a bug to the wonderful people who maintain strawberry perl I ask here just in case i missed something obvious..

    The fact hitting me is that I cant get cpan client to report correctly modules versions installed.

    about cpanminus option

    I know cpan is not the only client to access CPAN and cpanm is the preferred solution for many of us, but it seems it has some issues (even if distributed along the portable edition!) because of paths expressed Ó la unix and some other strangness like cpanm --self-upgrade failing.

    the problem with cpan client

    Working with freshly downloaded and unzipped strawberry version and launching the portableshell.bat that come with each strawberry portable edition, and working, for example, with SDL module I have the following:

    ---------------------------------------------- Welcome to Strawberry Perl Portable Edition! * URL - http://www.strawberryperl.com/ * see README.TXT for more info ---------------------------------------------- Perl executable: C:\right\path\strawberry-perl-5.26.0.2-64bit-portable +BIS\perl\bin\perl.exe Perl version : 5.26.0 / MSWin32-x64-multi-thread cpan> r SDL .. All modules are up to date for SDL

    But with the non interactive call (I suppose it's the same program anyway):

    cpan -D SDL SDL ---------------------------------------------------------------------- +--- (no description) F/FR/FROGGS/SDL-2.546.tar.gz (no installation file) Installed: not installed CPAN: 2.546 Not up to date Tobias Leich (FROGGS) froggs@cpan.org

    All configuarations ( reviewed with o conf ) relative to working dirs ( build_dir cpan_home histfile keep_source_where make make_install_make_command patch prefs_dir ) are correct; absolute paths pointing to the current running version. Also @INC is correct for every portable distribution with strawberry prepended to it. The same for the PATH environment variable.

    This happens with versions: strawberry-perl-5.26.1.1-32bit-portable  strawberry-perl-5.26.0.2-64bit-portable strawberry-perl-5.24.2.1-64bit-portable strawberry-perl-5.22.3.1-64bit-portable strawberry-perl-5.20.3.3-64bit-portable

    Also happens:

    cpan> r Not_Existing_Module .. All modules are up to date for Not_Existing_Module

    What can I do? I missing something very simple? Thanks for the attention.

    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
where is whatsnew or changes in strawberry perl package
2 direct replies — Read more / Contribute
by toohoo
on Nov 20, 2017 at 06:59

    Hello dear PerlMonks

    I'm searching for a whatsnew.txt or changes.txt for a concrete perl version in the downloaded package (portable version). I guess I only do oversee something. May someone please point me a hint?

    bes regards and thanks in advance, Thomas

New Meditations
Rosetta Dispatch Table
6 direct replies — Read more / Contribute
by eyepopslikeamosquito
on Nov 21, 2017 at 16:14

    Ha ha, nysus just reminded me of an old interview question I used to ask. Implement a simple dispatch table.

    Let's start with a specification:

    • The key of the dispatch table is a string \w+
    • The name of the callback function is the key name with _callback appended
    • Each callback function takes a single string parameter and returns a positive number

    You must write the invoker function, which takes two arguments (the name and the string argument to be passed to the callback):

    • If the name is invalid (e.g. "fred" below), invoker must return a negative number
    • Otherwise, invoker must pass its second argument to the callback function and return what the callback function returns

    To clarify, here is a sample implementation.

    use strict; use warnings; # Callback functions --------------------------------------- sub first_callback { my $z = shift; print "in first_callback, z=$z\n"; return 1; } sub last_callback { my $z = shift; print "in last_callback, z=$z\n"; return 2; } # Implementation of dispatch table ------------------------- # (You need to write this code) my %op_table = ( first => \&first_callback, last => \&last_callback, ); sub invoker { my ($name, $z) = @_; exists($op_table{$name}) or return -1; $op_table{$name}->($z); } # Main program for testing --------------------------------- for my $name ( "first", "last", "fred" ) { my $rc = invoker( $name, $name . '-arg' ); print "$name: rc=$rc\n"; }

    Running the above test program produces:

    in first_callback, z=first-arg first: rc=1 in last_callback, z=last-arg last: rc=2 fred: rc=-1

    Points to consider:

    • Is a hash the recommended way to implement a dispatch table in Perl?
    • How many other ways can you think of to implement it in Perl? (working demonstration code would be good)
    For more fun, feel free to implement the above specification in another language of your choice.

Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
[Your Mother]: Most health insurance will cover that.

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (7)
As of 2017-11-23 17:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    In order to be able to say "I know Perl", you must have:













    Results (336 votes). Check out past polls.

    Notices?