Hi wise monks,

What is the fastest way to go from XML to perl? I have 16MB+ XML files that are taking many seconds.

I have tried XML::Simple XML::Fast and XML::Bare, but all are surprisingly slow. Normalised its: Simple 1.0, fast 0.55, bare 0.4. But even then, that seems rediculously slow, with 3GHz machines still taking 10+ seconds.

In comparison, I wrote a dodgy C program that takes the XML and outputs a eval'able perl literal structure of nested array/hashes. Running the program and eval'ing the output is nearly 3x faster than xml::bare!

However I feel like I am re-inventing the wheel here (my dodgy program doesn't support attributes) and people must know a fast way to go from xml to perl already?

My other question is: Since eval is where most of the processing time is, is there some sort of 'direct' memory format for perl? For example: I would like my C program to output a 'memory blob' of nested arrays/hashes/scalers that would go straight into Perl, without having to 'parse'/'eval' anything.

The structures I want to put in are mostly like this:

{'elements' => [ 
  'element' => 
    { 'item' => 'value', 'item2' => 'value' } , 
  'element2' => { 'item' => 'value', 'item2' => 'value' } , 
] , 

'elements2' => [ 
  'element' => { 'item' => 'value', 'item2' => 'value' } , 
  'element2' => { 'item' => 'value', 'item2' => 'value' } , 

] }
[download]

i have a problem one Gearman::Client or Gearman::Task. for this way,

Gearman::Task->new($func, $arg, \%options)
[download]

i set the options "uniq" and "timeout", but it cannot work,

use Gearman::Client;

my $client = Gearman::Client->new;
$client->job_servers('127.0.0.1:7003');
my $taskset = $client->new_task_set;

$taskset->add_task('fun' => undef ,{
uniq => 1,
on_complete => sub{print ${$_[0]}},
timeout => 2,
} );
$taskset->wait;
[download]

-----------

use Gearman::Worker;

my $worker = Gearman::Worker->new;
$worker->job_servers('127.0.0.1:7003');
$worker->register_function('fun' =>\&w);
$worker->work while 1;

sub w{
    print "3";
    return 3;
}
[download]

i want to resold 2 problem, 1) run the same names of functions on workers in parallel, so i try the option "uniq", but it's not any result. 2) runing when the client call a function not existed, so i try the timeout, but ..

or help me how to get functions registed on server.

I'm running perl on windows with active perl 5.24 x64. This mystery issue is really bothering me. So, I'm here to seeking for some wisdom.

Lets call my script getopt.pl and it takes the input and doing something. However, whenever the value in the variable is "E48.2", the value is creating issue causing the script to fail miserably.

Input:
1. getopt.pl --platform=1 --version=E48.1 ..... ok
2. getopt.pl --platform=1 --version=E48.2 ..... Failed
3. getopt.pl --platform=1 --version=48.2  ..... ok
4. getopt.pl --platform=1 (script find version value E48.2) ... failed

Sample code:
use Getopt::Long;

my $platform    = 0;
my $version     = undef;
my $suffix      = undef;

my $flag1       = 0;
my $flag2       = 0;

GetOptions ('platform=i'    => \$platform,
            'version=s'     => \$version,
            'suffix=s'      => \$suffix,
            'flag1'         => \$flag1,
            'flag2'         => \$flag2,);

if ($platform == 1)
{
    if (!defined($version))
    {
         Find version number!!
         $version = E . "$valuefind"; ($version will be E48.2)
    }

    print "Find version: " . $version . "!\n";

    if (!defined(Suffix) && defined($version))
    {
         Find suffix value, let's say suffix is F!!
    }

    print "Find suffix: " . $suffix . "!\n";
}

Output for each input is like:
1. Find version: E48.1!
   Find suffix: F!
   
2. Find version: E48.2!
   Use of uninitialized value $suffix in concatenation (.) or string a
+t getopt.pl.
   
3. Find version: 48.2!
   Find suffix: F!
   
4. Find version: E48.2!
   Use of uninitialized value $suffix in concatenation (.) or string a
+t getopt.pl.
[download]

For some reason, when the value in $version is E48.2, the script can't enter the last if clause to find the $suffix value. Tried a few other number all seems to be okay....E48.3, E48.4 .. 5.. 6.. E74.0 E64.5 ... etc

Chris

How to wrap multiple programs in one main program?

perl Main.pl plot -file FILE -length LENGTH

perl Main.pl calc -length 20 -width 30

So Main.pl contains two sub-programs 'plot' and 'calc'. User can call anyone of them, based on their need.

#################  PLOT program here

#!/usr/bin/perl -w
use Getopt::Long;

my $data = "file1";
my $length = 4;
my $verbose;

GetOptions (
    "length=i" => \$length, 
    "file=s"   => \$data,
    "verbose"  => \$verbose
);

if (!@ARGV) {
    print "$0: Argument required.\n";
    exit 1
}


my $fh = read_fh ($data);
while (<$fh>) { print "$_\n"; }


##sub here
# Open and Read a file
sub read_fh {
    my $filename = shift @_;
    my $filehandle;
    if ($filename =~ /gz$/) {
        open $filehandle, "gunzip -dc $filename |" or die $!;
    }
    else {
        open $filehandle, "<$filename" or die $!;
    }
    return $filehandle;
}



################# CALC program here

#!/usr/bin/perl -w
use Getopt::Long;

my $width = 5;
my $length = 4;
my $verbose;

GetOptions (
    "width=i" => \$width, 
    "length=i"   => \$length,
    "verbose"  => \$verbose
);

if (!@ARGV) {
    print "$0: Argument required.\n";
    exit 1
}


my $total=$width*$length;
print $total;

[download]

I have a 50 Mb file:

Suppose I slurp it and do some matching:

use strict;
use warnings;
my $s = do { local ( @ARGV, $/ ) = 'x'; <> };
$s =~ /x/;
[download]

$ /usr/bin/time -f %M perl fmap.pl
[download]

Maximum resident set size reported as 53596 kbytes. Fair enough. Then I learn about File::Map, and do this:

use strict;
use warnings;
use File::Map qw/ map_file /;
map_file my $s, 'x', '<';
$s =~ /x/;
[download]

105844. Twice as much memory consumed. Actually, I'd expect, quoting POD,

loading the pages lazily on access. This means you only 'pay' for the parts of the file you actually use.

-- match consumes a single byte, hence only a "page" was loaded, no? Not the whole file. Otherwise, what's the point of example in synopsis? OK, maybe I'm wrong and Perl's regex engine wants a string in RAM, physically. But, if match was unsuccessful, e.g. $s =~ /y/; then -- 54676. Looks like a copy is made on each successful match:

$s =~ /x/; 
$s =~ /x/; 
$s =~ /x/; 
$s =~ /x/; 
$s =~ /x/; 
[download]

Then: 310784.

But not in a loop: $s =~ /x/ for 1 .. 5; Then, again, 105848.

That's all rather weird. Same happens on Windows, too. (There was another issue, on Windows -- it suddenly refused to map a 'merely' 1 Gb file, and it appears that CreateFileMapping expects a continuous block in virtual memory of required size -- which can either happen or not even during the same day. Doesn't look as usable to me. But perhaps it's not Perl issue.)

I'm asking, because at first I was enthusiastic about this patch. Now I'm not so sure.

I have a TK Scrolled Tree with, well, scrollbars. It is created thusly ...

$TK{'perltree'}=$TK{'vl'}->Scrolled('Tree',
                                    -separator        => ':',
                                    -background       => $COLOR{'white
+'},
                                    -font             => $FONT{'SAP8BO
+LD'},
                                    -exportselection  => 1,
                                    -selectmode       => 'single',
                                    -scrollbars       => 'ose',
                                    -selectforeground => $COLOR{'limeg
+reen'},
                                    -selectbackground => $COLOR{'grey'
+},
                                    -browsecmd        => \&perlTreeSel
+ection,
                                    -width            => 20)->pack(-fi
+ll   => 'both',
                                                                   -an
+chor => 'n',
                                                                   -ex
+pand => 1);
[download]

Later ... after I populate the tree I want to set the x scrollbar to 75% of it's viewable region and have tried many variations but can't get it to work.

I have tried Subwidget and xview and xviewMoveto all to no success

  # Set scroll to 32
  $TK{'perltree'}->xview(32);

  # Focus on the perltree
  $TK{'perltree'}->update;

[download]

A grateful nzsvz9

Dear monks,

at $work, we use SWIG to generate a Perl wrapper for a large C++ library. SWIG creates glue code in XS and pure Perl based on the C++ class definitions, and the XS code is then compiled against the header files of a particular version of Perl. This works great and you can use the same SWIG interface file to generate a Python, Java and C# wrapper as well.

The problem is, when the XS code is compiled against a particular version of Perl, say 5.18, the resulting compiled library is only compatible with the same (major) version of Perl. Our customers use a range of Perl versions, from 5.10 through to the latest one, so we have to compile and provide support for an ever increasing number of versions, even though the actual C++ library is exactly the same in each case. It was manageable for 5.6 and 5.8, which were long-lived versions, but it's become exasperating since the move to annual Perl releases.

Can you point me to any resources that describe or discuss the rationale for why XS code could not be made binary compatible between Perl versions? Or why there couldn't be some kind of reduced XS API that would stay binary compatible even if some parts change? Which authority should I petition to make it so?

However it currently shows any matching RPM
i.e
hostname1 redhat-release 5.11.0.4
hostname1 redhat-release-notes 52
hostname2 redhat-release 5.11.0.4

What I need is to find a way to exclude the match on "notes"

for (@{$systems}) {
   my $systemid = $_->{'id'};
   ## package test
   my $packages = $client->call('system.list_packages', $session, $sys
+temid);
   for my $package (@$packages) {
## the next line limits to the exact rpm you wish or else you get ever
+ything
      next unless $package->{'name'} ~~ /redhat-release/;
      my $systemname=$_->{'name'} . " ";
      chomp $systemname;
      print $systemname . " " ;
      print $package->{'name'} . " ";
      print $package->{'release'};
  print "\n";
   }
}
[download]

Can any kind Monk help , to exclude "notes"
Thanks

I thought I had a reasonable handle on regexes but occasionally problems shatter my confidence. I am trying to match Roman Numerals in the range i to xxxix. The numerals maybe preceded by a left bracket and maybe followed by i. a period (ii) a right bracket or (iii). a right bracket followed by a period. The entire pattern is always terminated with a space.
It all appears to work ok except when the string being searched comprises just a single space, whence it is (incorrectly IMHO) matched.
The part of the pattern to the left of the cluster that contains the space that is matched (ie the roman numeral cluster) has a quantifier of {1,1}, so I really don't undertand, if there are no valid characters in the string before the space, why the space should be matched.
Any help would be greatly appreciated.
This code outputs Matched ' ' in ' '

use strict;
#use re 'debug';

{
  my ($rv, $linestr, $pattern);
  
  $linestr = ' ';
  $pattern = '^\({0,1}(((ix)|(iv))|(x{0,3}((ix)|(iv)))|(x{0,3}(v{0,1}i
+{0,3}))){1,1}((\)\. )|(\) )|(\. )|( )){1,1}';

 if( $linestr =~ m/$pattern/i)
  {
    print ("Matched '$&' in '$linestr'\n");
  }
  else
  {
      print ("Not matched\n");
  }
}

[download]

I'm running a webserver on a local machine. I want to automate the process of setting up a website on it, mostly as an exercise to get more proficient with writing larger programs with Perl and getting familiar with more tools and modules out there. When setting up a new website, I'd like to update the apache config file with a very simple virtual host to direct traffic to the site:

<VirtualHost *:80>
    DocumentRoot /var/www/temp
    ServerName temp.mydomain.com
</VirtualHost>
[download]

Now it would be a simple matter to just append these lines to the end of the config file. But that's not a very elegant solution. I'm wondering what tools other Monks might have used to modify apache config files. It doesn't have to be a tool specific to apache like a cpan module. I'd be particularly interested to know if learning something like Template::Toolkit or other general purpose tools might allow me to intelligently handle updating config files in general.

If someone could steer me in the right general direction or things I should investigate, I'd appreciate the help.

print "Content-Disposition: attachment; filename=\"myarchive.zip\"\n\n
+";

my $z = new Archive::Zip::SimpleZip '-', Stream => 1;

my $fh = $z->openMember(Name => "myarchive.zip");
print $fh <binary data here>;
close($fh);

$z->close();
[download]

Pi day isn't quite over, but given that most know about my Raspberry Pi work, I thought I'd share something.

I have been focusing on creating a physical layout for all of the supported Integrated Circuits and other peripherals that are available to Perl under the Pi, so that I can create a full-blown automated test regimen that runs continuously against the code using my Test::BrewBuild software.

Because the work is very precise and requires diligence to ensure everything is as connected properly as it is confirmed that numbers match up so that when proper tests are finally written everything aligns, I thought I'd share a tiny piece of what I was working on before Pi day is over.

Given this diagram, which utilizes a RPi 3, an MCP3008 analog to digital converter, an MCP4922 digital to analog converter and a 74HC595 shift register as a baseline, here's some base initial test code that produces human-readable output so I can ensure the setup is reasonable:

use warnings;
use strict;
use feature 'say';

use RPi::WiringPi;
use RPi::WiringPi::Constant qw(:all);

my ($dac_cs_pin, $adc_cs_pin) = (12, 26);
my $adc_shiftreg_in = 0;
my $adc_dac_in = 1;

my $pi = RPi::WiringPi->new;

my $dac = $pi->dac(
    model => 'MCP4922',
    channel => 0,
    cs => $dac_cs_pin
);

my $adc = $pi->adc(
    model => 'MCP3008',
    channel => $adc_cs_pin
);

print "DAC...\n\n";

for (0..4095){
    $dac->set(0, $_);
    if ($_ % 1000 == 0 || $_ == 4095){
        say $adc->percent($adc_dac_in);
    }
}

my $sr = $pi->shift_register(100, 8, 21, 20, 16);

print "\nShift Resgister...\n\n";

my $sr_pin = $pi->pin(100);

$sr_pin->write(HIGH);

say $adc->percent($adc_shiftreg_in);
[download]

Output:

DAC...

0.00
24.24
48.68
73.02
97.46
99.80

Shift Resgister...

100.00
[download]

Much is on the chopping block for change, but I am making no fundamental changes until my CI is complete, and I get a much better understanding of what isn't working properly, and where. I know that PWM requires root which actually crashes the Pi if you don't sudo, and I know that Interrupts aren't doing the right thing.

This step back from coding to focus on tests first, is how I usually do things. Having wrapped a lot of this code, it's come off as a bit of a new challenge to me (because it isn't write tests first then code, it's been code first, then think tests), but I've realized I need to get back to basics; test it first, then move on.

Anyways, as I said early this morning, I'll say the same thing heading out. Happy Pi day ;)

Those who enter here,
Seeking wisdom found elsewhere,
Google is their friend.