The Monastery Gates

 ( #131=superdoc: print w/replies, xml ) Need Help??

and Create a new user.

New Questions
Recomendations For Learning perl?
7 direct replies — Read more / Contribute
on Dec 07, 2016 at 15:44

All, I want to seriously expand my Perl knowledge. I am a network engineer and I have seen the powers of Perl and how it can make the job easier. I have limited programming experience. I took an intro to Java class, an HTML Class, a Ruby on rails class, and a programming for networking class where I learned Linux and pearl. Even though I like all of you monks, I would like to only come here for the real advanced stuff. How do you recommend that I go about mastering pearl programming? Do you have book recommendations or is it better to take a class?

resampling an image using GD not working on Linux
2 direct replies — Read more / Contribute
by Discipulus
on Dec 07, 2016 at 04:36
Hello estimated monks!

I recently released picwoodpecker which latest version with a minor fix is on github.

It seems the program does not run well on Linux (it was developped and tested on win7 only).

With a bit of pain i'v set up a Linux Ubuntu 16.04 LTS 32 bit as a virtual machine using virtualbox.

The problem arise when the application try to use the copyResampled GD method:


GD Warning: one parameter to a memory allocation multiplication is neg
+ative or zero, failing operation gracefully

line 618
[download]

The Ubuntu machine has perl 5.22 and GD version is 2.53

I've tryed to reduce the problem to the simplest one and I ended with the following:

use strict;
use warnings;

use GD;

#UPDATE: need the following line to have a real 'smooth' resampling
GD::Image->trueColor(1);

my $file =$ARGV[0];
die "Please feed a jpg file.." unless -e $file; my$orig_gd = GD::Image->new($file); my$photo_ratio = 0.3;

my $small_w = int($orig_gd->width  * $photo_ratio); my$small_h = int($orig_gd->height *$photo_ratio);

draw_photo ($file); ###################################################################### +########## sub draw_photo { my$file_path = shift;
# create the resized but still empty GD image
my $resized = GD::Image->new($small_w,$small_h); # copy from source into resized on$resized->copyResampled($orig_gd,0,0,0,0,$small_w,
$small_h,$orig_gd->width,
$orig_gd->height); # save open my$out, '>', time.'.jpg' or die "unable to open for write";
binmode $out; print$out $resized->jpeg or die "unable to write jpg data!"; close$out;
}
[download]

The above runs fine on my win7 machine (perl 5.14 GD 2.46) and creates a resampled image.

It also creates a resampled image on Ubuntu so it does not complains about the zeros! So i'm stucked and seek for your wisdom.

The relevant part of the original code that fails on Linux is the following:

# @files is ArrayOfArray
# each element contains pic data as follow:
# 0 path
# 1 x
# 2 y
# 3 orientation
# 4 datetime joined with underscores
# 5  GD object of THUMB
# 6  [ GD object of PHOTO]
# the last field [6] will be filled only for current file ( which inde
+x is hold in $ph_index) # and for elelments to be preloaded: from ($ph_index - $preload) to ( +$ph_index + $preload) # thumb data [5] will be empty if$nothumbs is defined via -nothumbs c
+ommandline switch

######################################################################
+##########
sub draw_photo {
my $ph_index = shift; print "\tdraw_photo got:\n\t",(join '|',map{defined$_ ? $_ : 'undef +'} (@{$files[$ph_index]}[0..4],$files[$ph_index]->[5]?'THUMB':'NO DATA',$files[$ph_index]->[6]?'PHOTO':'NO DATA', )),"\n" if$debug;
$tk_ph_image->delete if$tk_ph_image->blank;

# some tk stuff removed

my $small_w = int($files[$ph_index]->[1] *$ph_ratio);
my $small_h = int($files[$ph_index]->[2] *$ph_ratio);

# create the resized but still empty GD image
my $resized = GD::Image->new($small_w,$small_h); # copy from source into resized on # NOTE$files[$ph_index]->[6] containf the GD object$resized->copyResampled($files[$ph_index]->[6],0,0,0,0,
$small_w,$small_h,
$files[$ph_index]->[6]->width,
$files[$ph_index]->[6]->height);

$tk_ph_image->configure( -file => undef, -data => MIME::Base64::encode($resized->jpe
+g())
);
# configure the Tk::Label to use the Tk::Photo as image
$photo_label->configure(-image =>$tk_ph_image );

# some display and tk stuff removed
}
######################################################################
+##########
[download]

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.
Can not Dance on Windows
by FreeBeerReekingMonk
on Dec 07, 2016 at 02:55
I developed a web application in Dancer2. As plackup does not https, I wanted an Apache 2.4 frontend to do the securing. Then it went downhill. ApacheLounge does not provide a mod_proxy_psgi, compiling it with the same (MSVC14) as Apache, it goes quickly down a INC dependency hole that made me install cygwin with all the dev headers libs... but I was not able to compile it. I then tried mod_proxy_fcgi (and mod_fcgi), but that requires Dancer to be served by Starman or similar. Unfortunately, Starman does not work on Windows. I then went for the regular cgi, which is still there. Here is where it gets weird:

I found an apache rule to execute the cgi if it does not contain a dot in the name , everything with a dot is served directly by Apache, so it is not that slow... As I wanted to capture the name, instead of !\. I have ^(/^\.*)$and the H= means that it treats this rewrite as a cgi script, the E adds a new variable to %ENV RewriteRule ^(/[^\.]*)$ "C:/myapp/public/dispatch.cgi" [E=MYPATH_INFO:$1,H=cgi-script] However, in app.pm, request->dispatch_path, a constant which can not be modified is always "/" while$ENV{PATH_INFO} and request->path do contain the right path. This means get "/" => sub{} is always running, even if we want to go to other pages.

By doing a get '/mypage' => $SUBROUTINE{'/mypage'} = sub {....} we can keep the plackup version working, and have the sub in a hash, to serve at / when this anomaly is detected. However, it has other problems, like the browser getting recursively redirected to /login/login/login...etc.. (code snippet will follow as soon as I have time to make a small selfcontained example). So my question: Any monks successfully implemented Dancer2 applications under Apache on Windows? Pragma clash across modules: bignum and Math::BigFloat 4 direct replies — Read more / Contribute by Athanasius on Dec 06, 2016 at 02:04 Hi, Background. The problem. I’ve reduced the problem to a minimal case as follows: Create 3 files in the same directory: # 1725_Pragma.pl use strict; use warnings; use First; use Second; [download] # First.pm package First; use strict; use warnings; #use bignum; print "First\n"; 1; [download] # Second.pm package Second; use strict; use warnings; use Math::BigFloat; print "Second\n"; my$f = Math::BigFloat->new(2);
$f->bsqrt(); print "$f\n";

1;
[download]

With use bignum commented out as shown above, the output is as expected:

16:38 >perl 1725_Pragma.pl
First
Second
1.41421356237309504880168872420969807857

16:38 >
[download]

<Update> And I get the same value for the square root of 2 if I just run perl Second.pm on its own. </Update>

But with use bignum uncommented, the result is simply wrong:

16:38 >perl 1725_Pragma.pl
First
Second
2

16:40 >
[download]

So, my questions are:

1. Is this a bug?
2. How can a pragma declared in one namespace affect the behaviour of code in a different (and supposedly separate) namespace?
3. Is there a workaround that will allow me to keep the current implementations of my two solutions and run them together in the same test script?

In relation to question 3, note that I’ve tried adding no bignum to the end of First.pm or to the beginning of Second.pm, but this had no effect. :-(

Setup.

Thanks,

 Athanasius <°(((>< contra mundum Iustus alius egestas vitae, eros Piratica,

Need Raw Binary Output
by Anonymous Monk
on Dec 05, 2016 at 15:35

I'm generating random 32 bit integers based on Math::Random::MTwist. I want to pipe the raw binary output, but (obviously) print() won't do. Neither will syswrite() to STDOUT.

Am I missing something simple?

Can't locate object method ""
2 direct replies — Read more / Contribute
by chris212
on Dec 05, 2016 at 11:32

Does anyone know what may cause this error?

Can't locate object method "" via package "IO::File" at G:\path\to\mys
+cript.pl line 1189
[download]
It happens very intermittently. I have run the script thousands of times in a loop unable to reproduce the problem, but I have seen it twice. This is line 1189:
my $chunk =$th->join();
[download]

That line is in an "output" thread. It is using a file handle, and will write the data contained in $chunk (2D array reference) to a file using Text::CSV_XS. The thread it is joining is one of many "worker" threads which do not use file handles. The "input" thread which starts the worker threads does use a file handle and reads a different file using Text::CSV_XS. The "input" and "output" threads both require the Text::CSV_XS module (depending on arguments passed to script), so they will both load the module rather than inherit it from the parent thread. Using Perl 5.18.2 on Windows. I have not seen it on Linux yet. Memory usage while tallying instances of lines in a .txt file 6 direct replies — Read more / Contribute by TJCooper on Dec 05, 2016 at 11:30 Given input data in the form of: c 8 336158 75 75M 74 c 12 828707 74 74M 73 w 10 528559 74 74M 0 c 15 267766 74 74M 73 c 12 828707 74 74M 73 c 14 491797 74 74M 73 [download] I am trying to tally the instances of records based on columns 1 (which has the header 'Strand' - this can be variable in position hence the use of List::Util qw(first)) as well as columns 2 and 3. The main chunk of code that accomplishes this is simply:  my @headers = split("\t",<$IN>);
my $index = first{$headers[$_] eq 'Strand'} 0..$#headers;
while (<$IN>) { chomp$_;
my @F = split("\t", $_); if (exists$hits{$F[$index+1]}{$F[$index+2]}) {
} else {
$hits{$F[$index+1]}{$F[$index+2]}{'w'} = 0;$hits{$F[$index+1]}{$F[$index+2]}{'c'} = 0;
}
$hits{$F[$index+1]}{$F[$index+2]}{$F[$index]}++ } [download] This is then printed in a simple manner to form files like these: 1 4 1 0 1 5 1 0 1 31 1 0 1 74 1 0 1 89 1 0 1 116 1 1 1 118 1 0 1 122 1 0 1 126 0 1 1 140 0 1 1 141 0 1 1 148 2 0 1 158 0 1 1 159 1 0 [download] Column 2 and 3, along with the frequency counts of each for W and C. This approach however requires a rather a lot of memory - around 800MB for an input file of ~100Mb. Are there any clever tricks or alternative methods that I could use in order to reduce the memory requirements? I note that for any given column 2-column 3 combination, a key and a blank (zeroed) value is stored the first time it is encountered - this is done as the output file is required in the format shown above where '0' is filled in. This may be increasing memory usage further when the zeros could be added afterward (perhaps during printing), but i'm entirely sure or how I would do this. Testing Wrapped LDAP Classes 1 direct reply — Read more / Contribute by yulivee07 on Dec 05, 2016 at 10:39 Hello fellow Perl-Monks, I am expanding my knowledge in testing right now. I want to test some functions of mine which interact with an LDAP-Server. This might sound like a stupid question, but what is the best way to deal with Wrapper-Classes? Context: I write a module, which gets some Users from LDAP. To communicate with the LDAP, I use a provided module from my workplace which wraps some system-specific parameters in the LDAP-methods (Utils::Ldap::CompanyLdap) and provides some additional methods. This module again is a subclass of another LDAP-Wrapper Module (Utils::Ldap::Base) which finally uses Net::LDAP. Now, in my program I use the first Ldap-Module e.g. package MyAwesomeProgram; use Utils::Ldap::CompanyLdap; sub read_users { # code that reads users from Ldap # searchGetEntries/get_value is provided by Utils::Ldap::CompanyLda +p foreach my$entry ( $ldap->searchGetEntries() ) { my$uid = $entry->get_value( 'uid' ); #... do something more } } 1; [download] I want to test the read_users function of my program, which gets its users via Utils::Ldap::CompanyLdap. How do I mock this? As you see, I do not directly interact with a Net::LDAP-Object I have already understood that there is Test::Net::LDAP::Mock/Test::Net::LDAP::Utils qw(ldap_mockify) which can mock an Ldap Connection. What I do not understand yet: How can I use this in conjunction with my Wrapper Module? My module uses the code and the functions of our Ldap-Wrappers. Would the correct way be to write mocking code for the wrappers (e.g. Utils::Ldap::CompanyLdap::Mock), or is there a way of overwriting the Net::LDAP Object which is used by the Base-Wrapper Class Utils::Ldap::Base? I am not shure how to best approach this. Second Question: In case I get this working, is there a way of taking a Net::LDAP object and feeding it into my Mock-Object? I'd like to copy the datastructe of our LDAP to the Mock-Object. Kind regards, yulivee Capacity Planning 4 direct replies — Read more / Contribute by Aatus on Dec 05, 2016 at 10:25 I am VERY new to Perl but know its power and really need help to create a script that: a. Uses Perl::SSH b. SSH into appliances using username:password c. OPens a notepad or excel for IP address list d. Pings particular IP e. Writes to each IP the average latency d. Moves to next IP and logs into different appliance and repeats process Printing to STDOUT buffered when invoking Perl within a bash-script using tee 1 direct reply — Read more / Contribute by TJCooper on Dec 05, 2016 at 10:01 As a solution to recording terminal output into a log file, whilst still viewing output on the terminal (using code within a bash script itself rather than piping to tee on the command-line) I typically use: exec > >(tee "$DIR/Logs/System.log")

Near the top of the bash script.

This bash script eventually invokes a Perl script. Output printed to the terminal comes from both Bash and Perl, however, the inclusion of the above line causes the buffering of the Perl-specific portion of the output such that it's only displayed on the terminal once the script fully completes. Running the Perl script as a standalone provides the intended real-time updates, as does invoking it via Bash without the above line.

Could anybody explain why this is happening and also suggest a solution? The ultimate goal here is to provide real-time feedback to the user on the terminal, whilst keeping a hard-copy of this feedback in a log file.
Sorting array
4 direct replies — Read more / Contribute
by negativ_m
on Dec 05, 2016 at 09:52

Hello All,

I have an array which looks like this:

my @ar1 = (text1.txt, text1a.txt, text2.txt, text54.txt,...text1g.txt,...text54f.txt,...);

I would like to have always the last version of my names inside the array. The result should look like this:

my @ar2 = (text2.txt,...text1g.txt,...text54f.txt,...);

I would appreciate some help. Thank you in advance.

[Perl6] Slurpy array of named arguments?
2 direct replies — Read more / Contribute
by ctilmes
on Dec 05, 2016 at 09:16
I can ask for a slurpy hash of named arguments with '*%args', or a slurpy array of non-named arguments with '*@args', but I want an ordered list of Pairs (specified with 'name => value'). Is there a good way to get that?
class testing {
method newhash(*%args) {
for %args.kv -> $k,$v {
say "Hash Key $k => Value$v";
}
}
method newarray(*@args) {
for @args -> $k,$v {
say "Array Key $k => Value$v";
}
}
}

my $x = testing.newhash(a => 1, b => 2); # Messes with specified ord +er my$y = testing.newarray(c => 3, d => 4);  # Looks good, but doesn't w
+ork

my \$z = testing.newarray('e', 5, 'f', 6);  # Works, but ugly
[download]
Hash Key b => Value 2
Hash Key a => Value 1
Array Key e => Value 5
Array Key f => Value 6
[download]
New Monk Discussion
 SSCCE down? 2 direct replies — Read more / Contribute by haukex on Dec 08, 2016 at 03:02 Hi all, Unfortunately it seems http://www.sscce.org/ now points to http://coderanch.com/ - such is the danger of linking to off-site resources, it seems. Of course there's the on-site How do I post a question effectively? or I know what I mean. Why don't you?, but personally I'm not aware of an on-site resource that explains it quite like SSCCE does (well, used to). Can anyone recommend a node, or should we consider writing a new one? Regards,-- Hauke D

Create A New User
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (6)
As of 2016-12-09 06:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
On a regular basis, I'm most likely to spy upon:

Results (148 votes). Check out past polls.