Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
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
Perl Debugger rcfile on Windows
1 direct reply — Read more / Contribute
by VinsWorldcom
on Jul 31, 2015 at 15:14

    Windows Monks - has anyone gotten the Perl Debugger rcfile (.perldb / perldb.ini) to work on Windows? I can use the Perl debugger fine with 'perl -d <progfile> [args]', but if I have a .perldb (perldb.ini) file defined, I get mixed, unsatisfying results.

    I'm on Windows 7 x64 with Strawberry 5.18.1.

    Essentially I've tried .perldb and perldb.ini in both the current directory and my home directory. It seems only perldb.ini is recognized and when it finds it, regardless of location, I get the error:

    perldb: Must not source insecure rcfile ./perldb.ini. You or the superuser must be the owner, and it must not be writable by anyone but its owner.

    So I've tried to modify permissions of the perldb.ini file on Windows by breaking the parent inheritance on that file and making sure I'm the owner and the only one with "Full Permissions" - which still doesn't fix the problem.

    Anyone get this working successfully?

    UPDATE: I've narrowed it down in perl5db.pl.

    'use vars qw($rcfile);' does a check which for Windows will return 'perldb.ini' regardless explaining why '.perldb' has no effect, despite POD about running interactive vs non- mode.

    Then, that 'perldb.ini' file is (eventually) run through "sub is_safe_file" which does a 'stat()' and on Windows, is obviously not returning the proper value to create a false when bit-masked with 022. See the function in perl5db.pl for more details as well as POSIX::S_ISDIR() with $stat->mode values from Windows vs. Linux, which has the mode value I'm getting "33206" on Windows.

    That being said, I could do all sorts of things to fix this by editing perl5db.pl, but is there a way / argument /something to get this to work without me monkeying with a module's code?

Perl system command memory usage in threads
3 direct replies — Read more / Contribute
by rmahin
on Jul 31, 2015 at 14:24

    SOLVED Updated to perl 5.20.2 and all problems vanished.

    Hello! Been noticing some strange memory issues with a script I'm working on, and have come up with this to highlight the issues

    use strict; use warnings; use threads; use threads::shared; $|++; my $DONE :shared = 0; my $lock :shared; my $execMethod = $ARGV[0] || 0; if($execMethod !~ /[12345]/){ print "Must pass an exec method:\n"; print "1 = backticks\n"; print "2 = backticks synchronized\n"; print "3 = open\n"; print "4 = open synchronized\n"; print "5 = system\n"; exit 1; } sub execute{ my $cmd = shift; if($execMethod == 1){ `$cmd` }elsif($execMethod == 2){ lock $lock; `$cmd` }elsif($execMethod == 3){ open(my $fs, "-|", $cmd); foreach(<$fs>){}; close $fs; }elsif($execMethod == 4){ lock $lock; open(my $fs, "-|", $cmd); foreach(<$fs>){}; close $fs; }elsif($execMethod == 5){ system($cmd . ">nul"); } } sub worker{ while(!$DONE){ execute('echo hello world'); } } my @workers = map threads->create( \&worker), (1..30); print "Press <enter> to terminate\n"; <STDIN>; $DONE = 1; $_->join() for @workers;

    Script is invoked with <script>.pl executionMethod

    Question 1 relates to memory usage. Methods 2, 4, and 5 all exhibit a permanent memory creep. Is there a way to fix this and let this script run forever? If the solution is periodically join threads, this is not feasible. I have tried this a couple years ago and came across some bug but outlined in this node and changing to an approach like this would require far too much testing to ensure no other bugs occur. If there really is no solution, would be good to know :)

    Question 2: For methods 1 and 3, why do i need to synchronize them? If I do not, the script just hangs up usually after only a few seconds. Synchronizing this access kind of seems to defeat the purpose of running system commands in threads, is there something I can do differently?

    *I have been running this on Windows 2008 R2, using perl 5.18.2

    Thanks in advance for all your help

    UPDATE 1: Here is the log file from perfmon running test 5 for a little over a minute and eating roughly 150MB.

    UPDATE 2:

    perl -v output

    This is perl 5, version 18, subversion 1 (v5.18.1) built for MSWin32-x +64-multi-thread (with 1 registered patch, see perl -V for more detail) Copyright 1987-2013, Larry Wall Binary build 1800 [297570] provided by ActiveState http://www.ActiveSt +ate.com Built Sep 20 2013 15:07:17 Perl may be copied only under the terms of either the Artistic License + or the GNU General Public License, which may be found in the Perl 5 source ki +t. Complete documentation for Perl, including FAQ lists, should be found +on this system using "man perl" or "perldoc perl". If you have access to + the Internet, point your browser at http://www.perl.org/, the Perl Home Pa +ge.

    systeminfo

    Host Name: VCLOUD291 OS Name: Microsoft Windows Server 2008 R2 Enterprise OS Version: 6.1.7601 Service Pack 1 Build 7601 OS Manufacturer: Microsoft Corporation OS Configuration: Standalone Server OS Build Type: Multiprocessor Free Registered Owner: Windows User Registered Organization: Product ID: 55041-507-5915375-84291 Original Install Date: 4/23/2014, 12:10:03 PM System Boot Time: 7/31/2015, 1:49:06 PM System Manufacturer: Microsoft Corporation System Model: Virtual Machine System Type: x64-based PC Processor(s): 1 Processor(s) Installed. [01]: Intel64 Family 6 Model 46 Stepping 6 +GenuineIntel ~1862 M hz BIOS Version: American Megatrends Inc. 090004 , 3/19/2009 Windows Directory: C:\Windows System Directory: C:\Windows\system32 Boot Device: \Device\HarddiskVolume1 System Locale: en-us;English (United States) Input Locale: en-us;English (United States) Time Zone: (UTC-07:00) Arizona Total Physical Memory: 4,096 MB Available Physical Memory: 1,635 MB Virtual Memory: Max Size: 6,143 MB Virtual Memory: Available: 3,364 MB Virtual Memory: In Use: 2,779 MB Page File Location(s): C:\pagefile.sys Domain: WORKGROUP Logon Server: \\VCLOUD291 Hotfix(s): 46 Hotfix(s) Installed.
How to capture compile errors from child program?
4 direct replies — Read more / Contribute
by bulrush
on Jul 31, 2015 at 06:03
    I have a parent program, parent.pl that calls a child program, child.pl, like this:
    @z=`perl child.pl -option1 -option2`
    
    The whole command line for child.pl is in a scalar variable but that shouldn't matter. So I noticed that @z in parent.pl would return completely blank after I made some changes to child.pl. Lo and behold I had compile or syntax errors in child.pl, so none of my other error messages (written to STDOUT with "print") would be written from child.pl.

    So when I'm running parent.pl, how do I capture compile errors when calling child.pl? Do I have to do something like

    @z=`perl -c child.pl`;
    
    before I do anything else? Will @z return STDERR messages or just STDOUT? If I did
    @z=`perl child.pl -option1 -option2` or die "Possible compile errors in child.pl";
    
    Would that do what I want?

    Thank you. Looking for some input so I can learn more about this.

Replacement for the "unsupported" Graph module?
1 direct reply — Read more / Contribute
by pokki
on Jul 31, 2015 at 05:54

    Hello Monks,

    I've used the Graph module for lots of graph-related tasks and I've always been happy with it. I don't need a superfast module, or one that consumes very little memory, since I don't have many graphs and they aren't very big. I don't need complex operations either; neighbor/descendant/ancestor list, maybe some shortest paths.

    Is there an heir to Graph, now that its author has stopped maintaining it? Or should I just keep using it and hope it doesn't break in the future? What do you guys use, or do you just write your own adjacency maps?

Email Module
4 direct replies — Read more / Contribute
by caseycole589
on Jul 31, 2015 at 03:16

    I'm trying to convince my work to use Perl for our email in a web app running on asp.net is this do able or does any one have advice/opinions. How hard is it to get something like this working on a windows server? Any input would be appreciated. I know I could do this easily in c# and probably should, but I'm looking for any excuse to get Perl running on our servers. That way I can have an excuse for using it on more projects moving forward.

Rolling variable
7 direct replies — Read more / Contribute
by artperl
on Jul 30, 2015 at 09:35
    Dear Perl monks, I would like to seek recommendation on what could be a good solution here... I would like to monitor file count in a specific directory & record the count every hour. I would need to keep that counts somewhere for another calculation but I would like to keep only the last 8 counts, meaning throw away the oldest data & just keep the last 8 records. How can I effectively do this in perl? Thanks much!...
INIT {$SIG{__DIE__} and Getopt::Long
5 direct replies — Read more / Contribute
by demichi
on Jul 29, 2015 at 13:16
    Hi all

    I am normally using the following line to capture the die output into a logfile.

     INIT {$SIG{__DIE__}=sub {LOG_MSG("normal",3,"GENERAL","Script died: $_[0]") and close LOG;}}

    Now I am using also Getopt::Long. I don't want to have a logfile generated if somebody is chosing the wrong parameter. Therefore I let the script die with an usage output.

    Unfortunately if somebody choses a wrong getopt parameter now - I get a log error message because of the INIT-"die" setting as the log file is not opened yet.

    Example:
    G:\development\bin>x.pl -x > 4,GENERAL,Script warning: Unknown option: x print() on unopened filehandle LOG at G:\development\bin\x.pl line 45. + ### Version:2.0.0 NAME xxx > 3,GENERAL,Script died: 1 at G:\development\bin\x.pl line 14. ### > 4,GENERAL,Script warning: print() on unopened filehandle LOG at G:\d +evelopment\bin\x.pl line 45. ### print() on unopened filehandle LOG at G:\development\bin\x.pl line 45. + ### 1 at G:\development\bin\x.pl line 14. ### G:\development\bin>

    Every line marked with "###" at the end I do not want to have as output to STDOUT.

    Do you have an ideas how can fix it? Thanks.

    kind regards de Michi

    Code:
    use strict; use warnings; use Getopt::Long qw(:config no_ignore_case bundling); # Get options / my $VERSION = "2.0.0"; INIT {$SIG{__DIE__}=sub {LOG_MSG("normal",3,"GENERAL","Script died: $_ +[0]") and close LOG;}} INIT {$SIG{__WARN__}=sub {LOG_MSG("normal",4,"GENERAL","Script warning +: $_[0]")}} # Check Flags my $flag_help; my $flag_version; my $flag_config; GetOptions ( 'h|help' => \$flag_help, 'V|VER' => \$flag_version, 'c|config=s' => \$flag_config, ) or die USAGE(); # Check flags and print usage if ($flag_version) { print "Version: $VERSION\n"; exit; } if ($flag_help) { USAGE(); exit; } open(LOG,"> SCRIPTLOG_FILE") or die ("Can't open SCRIPTLOG_FILE: $!\n" +); close LOG; ### subs sub LOG_MSG { my $par_LEVEL = shift (@_); my $par_SEVERITY = shift (@_); my $par_FUNCTION = shift (@_); my @line = @_; print "> $par_SEVERITY,$par_FUNCTION,@line\n"; print LOG "$par_SEVERITY,$par_FUNCTION,@line\n"; } sub USAGE { my ($message)=<<'MESSAGE'; NAME xxx MESSAGE print "Version:${VERSION}\n$message"; }
Consistent xml formatting
1 direct reply — Read more / Contribute
by Haloric
on Jul 28, 2015 at 10:05

    Hi Monks,

    I have many xml files that I am attempting to compare with either XML::SemanticDiff or XML::SemanticCompare.

    Is there a way to get the XML ordered in a consistent way before I start this comparison, without calling out to a separate tool. They both get confused by slight ordering changes

    For example, I have elements that are

    <sequence name="b" .. <sequence name="a" .. <sequence name="c" ..

    I would like them ordered by the 'name' attribute before the comparison starts.

    I have looked at XML::LibXML::PrettyPrint but can't make it do what I want.

    I can see SemanticDiff copes with missing attributes, but not sure how it would cope with a missing '<sequence name="b" ' element all together without thinking it was a difference in attribute value, rather than entirely missing.

    Thanks

How to call a perl function without its context?
9 direct replies — Read more / Contribute
by kitomer
on Jul 28, 2015 at 05:34
    I want to call a Perl function and be sure it cannot access any variables declared in its context, just its local variables and passed arguments. Is this possible?
Performance of assambled regex
6 direct replies — Read more / Contribute
by Foodeywo
on Jul 26, 2015 at 08:04
    Dear Monks,

    today I re-stumbled upon an issue I quick-and-dirty solved a while ago but I want to solve it more elegantly while I am doing code polishing these days.

    I use Regexp::Assemble to assemble regex that are about 15kb to 87kb large. Now I very simply run through a large (~10GB) file and match the regex. I used to do this on the command line in the style

    perl -ne 'print if (/MYLARGEREGEX_HERE/../END_OF_BLOCK/)' inputfile > +outputfile

    this was fast as hell. However when my regex grew in size, I was not able to copy paste them into the bash so I started to read the regex from a file and did something like this

    #!perl use strict; use warnings; open my $fh_big_file, '<', $ARGV[0] || die; #first argument must be th +e input file open my $fh_regex, '<', $ARGV[1] || die; # second argument points to t +he file containing the regex my $regex = <$fh_regex>; while(<$fh_big_file>) { print if (/$regex/../^END_OF_BLOCK/); }

    The funny thing is, that this flavour of code costs me factor 20 in speed or even more. I can reclaim the speed by avoiding to store the regex in a variable, e.g.

    while(<$fh_big_file>) { print if (/MY_HUGE_REGEX_JUST_PLAIN/../^END_OF_BLOCK/); }

    so I assume this has something to do with fetching the content of the variable (from RAM to CPU?) over and over for each loop of while(<>), whereas inputing the regex directly doesnt need to re-read it every time.

    This approach however requires me to manually copy the regex to its place each time I run the whole procedure of "assembling, searching, processing, assembling, seachring, processing" and I would like to automize it without loss of performance. Any ideas?

    thanks and cheers!

    Update/Solution/Close

    The suggestion to use the o operator works. However it needs to be behind /$regex/ not behind /END_OF_BLOCK/. i.e. like shmem suggested:

    while(<$fh_big_file>) { print if (/$regex/o .. /^END_OF_BLOCK/); }

    thanks!

Pack + Fat32 timestamp
2 direct replies — Read more / Contribute
by tbr123psu
on Jul 25, 2015 at 18:06

    esteemed monks:

    greetings all! i've been struggling with this for days now, and figured it was finally time to ask for some help.

    I've been following the instructions found at http://virantha.com/2014/01/09/hacking-together-a-wifi-photo-frame-with-a-toshiba-flashair-sd-card-wireless-photo-uploads/ to set up a wifi SD card for use in a photoframe. I wanted to use Perl rather than the python referenced on the page because I generally prefer perl and because i kinda wanted to do it myself.

    it's been smooth sailing, right up to the point of having to submit a FAT32 timestamp to set the creation date of the uploaded file. This part has me completely stumped.

    i've been all over google, and the best reference I can find about the required formats is from this thread on stackoverflow: http://stackoverflow.com/questions/15763259/unix-timestamp-to-fat-timestamp. There's no search results here for fat32.

    interestingly enough, I was able to figure out how interpret the dates coming off the card (for the purposes of knowing which photos were the last ones added, so I can only upload new ones), but trying to apply the same logic in reverse did not work so well. I'm also not entirely clear on why it worked the way it did, such that they come out split up but when going in, the card wants just one string, but I suppose that's just quirkiness in the API i've got to live with.

    anyhow, i suspect the answer has something to do with pack, but i won't lie, i'm just flinging stuff at the wall in the hopes that it sticks. I thought i was making progress, in that I have some idea what the actual value for a current timestamp is that would be submitted to the api call (through trial and error/guesswork -- manually trying to make things up, based on the example given in the API documentation https://flashair-developers.com/en/documents/api/uploadcgi/).

    so i've got some idea what the value needs to look like, but for the life of me i can't get that output to generate programatically. it seems that it's inclusive of 0-9 and a-f, so it seems like a hexadecimal number (as per http://www.microbuilder.eu/Tutorials/Fundamentals/Hexadecimal.aspx), but being honest, this gets a little deeper than i usually go. thinking about it sometimes makes my head hurt.

    has anyone ever bumped into anything like this before or can offer any insight? code snippets below that do the relevant stuff with dates/times.

    here's the code that pulls the time and date from the card and interprets it.

    #Each row of the list is returned in the following format. #<directory>, <filename>, <size>, <attribute>, <date>, <time> # date 16 bit int -- bit 15-9 value based on 0 as 1980, bit 8-5 month +value from 1 to 12, bit 4-0 day, value from 1 to 31 # time 16 bit int -- bit 15-11 hour, 10-5, minute, 4-0 second / 2 # size my $fileList = getHttp($cardip, "command.cgi?op=100&DIR=/"); #print ($fileList . "\n"); my @fileArray = split("\n", $fileList); my @fileTimesArray; my $lastTime = 0; print (ref(@fileArray) . "\n"); foreach my $file (@fileArray) { if (index($file, ",") != -1) { print "working with file $file\n"; my ($directory, $name, $size, $att, $date, $time) = split(",", + $file); # example date, time = 18151,39092 my $day = ($date >> 0) & (2**5-1); my $month = ($date >> 5) & (2**4-1); my $year = ($date >> 9) & (2**7-1); $year = 1980 + $year; my $second = ($time >> 0) & (2**5-1); my $minute = ($time >> 5) & (2**6-1); my $hour = ($time >> 11) & (2**5-1); $second = $second * 2; print ("file: $name | $month - $day - $year | $hour : $minute +: $second | $epochTime\n"); #print ("file: $name | $date | $time\n"); #print ("day: $day\n"); #print ("month: $month\n"); #print ("year: $year\n"); #print ("second: $second\n"); #print ("minute: $minute\n"); #print ("hour: $hour\n"); my $perlMonth = $month - 1; my $epochTime = timelocal($second,$minute,$hour,$day,$perlMont +h,$year); if ($epochTime > $lastTime) { $lastTime = $epochTime; } push @fileTimesArray, { file => $name, epoch => $epochTime, si +ze => $size }; } }

    and here's the code for trying to generate a timestamp based on the timestamp returned from the file on disk.

    @info = stat($path->{file}); my $createdtime = $info[10]; print "regular created time is: $createdtime\n"; my ($sec, $min, $hour, $day,$month,$year) = (localtime($createdtim +e))[0,1,2,3,4,5]; # You can use 'gmtime' for GMT/UTC dates instead of 'localtime' $month++; my $displayYear = $year; my $realYear = $year; $year = $year - 80; $second = ceil($sec / 2); # example date, time = 18151,39092 --> not same format!?! # time 16 bit int -- bit 15-11 hour, 10-5, minute, 4-0 second / 2 #my $encSecond = $second & (2**5-1); #my $encMinute = $minute & (2**6-1); #my $encHour = $hour & (2**5-1); # date 16 bit int -- bit 15-9 value based on 0 as 1980, bit 8-5 mo +nth value from 1 to 12, bit 4-0 day, value from 1 to 31 #my $encDay = $day & (2**5-1); #my $encMonth = $month & (2**4-1); #my $encYear = $month & (2**7-1); #use integer; my $data = $year . $month . $day . $hour . $min . $second; print "using $data as input for pack\n"; #my $data = $second . " " . $minute . " " . $hour . " " . $day . " + " . $month . " " . $year; #my $createdtimeFat = pack "N8", $data; my $createdtimeFat = pack "N8", $year,$month,$day,$hour,$min,$sec +ond; #my $createdtimeFat = ($year << 25) | ($month << 21) | ($day << 1 +6) | ($hour << 11) | ($min << 5) | ($second << 0); #my $createdtimeFat = (($year & (2**7-1)) << 25) | (($month & (2* +*4-1)) << 21) | (($day & (2**5-1)) << 16) | (($hour & (2**5-1)) << 11 +) | (($min & (2**6-1)) << 5) | (($second & (2**5-1)) << 0); # 8 digits # 8 = year # 7 = year + month # 6 = month + day # 5 = day #### # 4 = hour # 3 = hour + month # 2 = minute + second # 4 = second #my $createdtimeFat = '469f9f01'; #my $hex = sprintf("0x%x", $createdtimeFat); #my $hex = printf("%x",$createdtimeFat); print "Unix time ".$createdtime." converts to ".$month." ".$day.", + ".($displayYear+1900)." ".$hour.":".$min.":".$sec." year (in offset +from 1980) is $year [real year is $realYear]\n"; #print $encSecond ." ". $encMinute ." ". $encHour ." ". $encDay ." + ". $encMonth ." ". $encYear . "\n"; print "createdtimeFat should look something like 46ef99c6\n"; print "createdtimeFat is $createdtimeFat\n"; my @unpacked = unpack("N8",$createdtimeFat); print "and unpacked: " . @unpacked . "\n"; my $setdate = getHttp($cardip, "upload.cgi?FTIME=0x" . $createdtim +eFat); print "result of setdate operation: $setdate\n";

    and this is the getHttp function/sub

    sub getHttp() { my $ip = shift; my $args = shift; my $status; my $url = "http://" . $ip . "/" . $args; #print ("accessing " . $url . "\n"); # set custom HTTP request header fields my $req = HTTP::Request->new(GET => $url); my $resp = $ua->request($req); if ($resp->is_success) { my $message = $resp->decoded_content; #print "Received reply: $message\n"; $status = $resp->decoded_content; } else { print "HTTP GET error code: ", $resp->code, "\n"; print "HTTP GET error message: ", $resp->message, "\n"; $status = $resp->message; } return $status }

    many thanks in advance for any help or guidance anyone can offer - i'm at wit's end, and i feel like i've got to be missing something!

ssl details cgi script
3 direct replies — Read more / Contribute
by alokranjan
on Jul 25, 2015 at 15:04
    Hi All, Can anyone please have a look at my cgi script to print the ssl certificate expirt date. I am picking the sitename from a html page and passing to the below cgi:
    use CGI qw(:standard); use CGI::Carp qw(warningsToBrowser fatalsToBrowser); use Net::SSL::ExpireDate; use strict; my $sitename; my $ed; my $expire_date; print header; print start_html("Thank You"); print h2("Thank You"); my %form; foreach my $p (param()) { $form{$p} = param($p); print "$p = $form{$p}<br>\n"; $sitename = $form{$p}; } #$sitename = "www.google.com"; chomp($sitename); $sitename =~ s/^\s+|\s+$//g; print "\nWebsite name is: $sitename.\n"; $ed = Net::SSL::ExpireDate->new( https => $sitename ); if (defined $ed->expire_date) { $expire_date = $ed->expire_date; print "$expire_date\n"; } print end_html;
    I am wondering why its not working, though a separate Perl script is working fine to get the expiry date. Any help/assistance would be highly appreciated.

    Thanks, Alok

New Meditations
Time for an application portfolio
8 direct replies — Read more / Contribute
by talexb
on Jul 27, 2015 at 12:04

    I have been tinkering with a few tools lately, and now want to put up a portfolio of some web applications that I am working on. I have an account on pair Networks (they also host this site), so I set up local::lib and went ahead and tried to install Mojolicious::Lite, since that's the platform I'm working on these days.

    No dice -- Mojo::Lite requires 5.10, and pair only has 5.8.9. I checked with the other provider I use, and they have 5.8.8.

    So the two options I can see are a) install an up-to-date Perl on one of those accounts, or b) have these web applications run on my home machine (perhaps using http://www.easydns.com to provide consistent name resolution -- not sure is this is still available).

    I could go find another web provider, but that's additional expense, and not really my best option right now. Feedback welcome!

    Alex / talexb / Toronto

    Thanks PJ. We owe you so much. Groklaw -- RIP -- 2003 to 2013.

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 cooling their heels in the Monastery: (6)
As of 2015-08-01 12:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found
    past polls