Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
Incorrect options supplied, exiting.
[download]

#!/usr/bin/perl
use strict;
use warnings;
use IO::Pipe;
use IO::Handle;
use IO::File;
my $system;
my @systems = ( '3par-S400', '3par-E200' );


#open( MYFILE, '>>data.txt' );
#foreach my $system (@systems) {
#    my $output = run_command($system);
#    while (<$output>) {
#        next if (m/^$/);
#        next if (m/KBytes/);
#        next if (m/VVname/);
#        last if (m/^\-\-\-\-\-.*$/);
#        s/^ *//;
#        s/ +/\|/g;
#        print MYFILE $_;
#    }
#}
#close(MYFILE);

#open( MYFILE, '<data.txt' );
#while (<MYFILE>) {
#    my $thisline = $_;
#    chomp($thisline);
#    my $gmetric="/usr/bin/gmetric";
 ## This is what we grab and build the array
## 22:28:29|08/30/10|r/w|I/O|per|second|KBytes|per|sec|Svt|ms|IOSz|KB|
## VVname|Cur|Avg|Max|Cur|Avg|Max|Cur|Avg|Cur|Avg|Qlen
## This is the data we get per line
# racprod_data03_500G_tpvv|t|674|674|674|6782|6782|6782|3.6|3.6|10.1|1
+0.1|2
#    my @array= ( $VVname, $t, $ioCur, $ioAvg, $ioMax, $kbCur, $kbAvg,
+ $kbMax, $svtCur, $svtAvg, $iokbCur, $iokbAvg, $Qlen) = split /\|/, $
+thisline;
#    foreach @array {
#    print $_;
#    }
#}
#close(MYFILE);

sub run_command {
    my $user      = 'gmon';
    my $system    = shift;
    my $protocol  = 'ssh';
    my $ssh_flags = "-l $user";
    my $command   = "statvv -ni";
    my $space     = " ";
    my $do_command = $protocol . $space . $ssh_flags . $space . $syste
+m . $space . $command;
    my $cmd = IO::Pipe->new;
    $cmd->reader($do_command);
    return $cmd;
}

[download]

package Aa;
use Bb;
my $object = Bb->new();
[download]

package Bb;
use Aa;
my $object = Aa->new();
[download]

package Aa;
use Bb;
my $result = Bb::some_function_which_does_not_create_object();
[download]

package Bb;
use Aa;
my $object = Aa::some_function_which_does_not_create_object();
[download]

I try to catch vhost data (multiple files) from Apache with the Module Apache::ConfigFile. This works so far.

But after that, I want to write the Hash of Hashes of (Hashes/Arrays) ... into XML file.

How may I iterate perfectly over unknown Hash of Hashes of Hashes or Arrays of ...

What I do not want: foreach () { foreach () { foreach () { ...

May you help me ?

I written one perl script and this perl script executing the jar file to fetch records from database.

Like

using backtics

So i want to make this perl script and jar file also as a single executable file.

I am writing GUI programs for users throughout our company. The users all have Windows workstations (mostly XP). I would like to package up these programs as individual, independent, Windows .exe files.

Now before a bunch of people jump all over me, let me make two points: 1) I am not trying to hide my source code from anyone—most of my users don’t know or care about Perl or programming, and although the programs are proprietary, I’m not real worried about theft by internal users. 2) I am under no illusions that this will make my programs in any way faster. All I ask is that it doesn’t slow them down significantly.

The reason I want to package each program is for simplicity of distribution to (and use by) the users. I’d like to copy the .exe file onto the network, or onto a USB drive, and just have the users use it from there, or copy it to their workstation. These people don’t have Perl installed on their workstations, and why should they?

I used to use ActiveState’s perlapp, from their Perl Dev Kit. But they want $150 for a license, and I have grown to dislike AS Perl over the past few years. Installing modules is a pain. I vastly prefer Strawberry Perl, and I mostly use that nowadays.

Then I tried Cava Packager. Nice slick interface, and everything builds smooth as ice cream. However, it does not package everything up into one nice bundle. It makes a nice, neat, small .EXE file (124k!), but requires that a 'lib' directory be installed in the same location. I took a look inside that 'lib' directory, and it was stunning. 860 encrypted library files, eight megabytes. Good God, what a mess. And if you try to install two Cava-packaged programs to the same location, their 'lib' files stomp on each other.

I have been playing with pp lately. It too is apparently a pile of crap. If you use the --gui option and your program dies for any reason, you get zero error indication, it just stops. It also does not know about "use lib" when scanning for dependencies. How insane is that? Here is a simple WxPerl program:

#!perl
use Modern::Perl;
use lib 'h:\\dev\\lib';
use lib 'h:\\dev\\MyAppDir\\wx';

use MyApp;

my $app = MyApp->new();
$app->MainLoop;
[download]

It’s short and simple, the boilerplate that most Wx apps follow. When I compile it:

pp sits and churns for a while, then creates a 4 meg .exe file. When I run this program, it sits and does nothing for about fifteen seconds, then returns to the prompt. Nothing, nada. So I removed the --gui option, re-compiled, and re-ran:

Can't locate threads/shared.pm in @INC (@INC contains: h:\dev\MyAppDir
+\wx h:\dev\lib CODE(0x2c1108c) C:\Users\myname\AppData\Local\Temp\par
+-myname\cache-c9e35a29c4569611f1a6576209856baa502c3ab1\inc\lib C:\Use
+rs\myname\AppData\Local\Temp\par-myname\cache-c9e35a29c4569611f1a6576
+209856baa502c3ab1\inc CODE(0x29950cc) CODE(0x29953f4)) at h:\dev\MyAp
+pDir\wx/MyApp.pm line 11.
BEGIN failed--compilation aborted at h:\dev\MyAppDir\wx/MyApp.pm line 
+11.
Compilation failed in require at script/test.pl line 8.
BEGIN failed--compilation aborted at script/test.pl line 8.
[download]

Can’t locate threads/shared.pm?? What is this? It’s the first thing in MyApp.pm! So I ran PAR’s scandeps on my little test program:

>scandeps mms_test.pl
'Math::BigInt::GMP' => '1.24',
'Modern::Perl'      => '1.03',
[download]

Yep, it does not follow "use lib" directives. I couldn’t believe it, so I even delved into the source code of Module::ScanDeps to confirm. Incredible.

So now I add the libraries to the pp command line:

It then grinds away for half an hour, using 80% of my CPU the whole time. What the HELL is it doing? I haven’t seen compile times like that since I used a mainframe. When it finally did stop (yes, 35 minutes later), I ran the program (7.5 megabytes). It sat for twenty seconds, then popped up a dialog box that said,

Yeah, that's helpful.

Are there any sane packagers for Perl?

Hi Monks, I don't know if I'm missing the obvious here, but I'm trying to use eval to catch errors in writing to a database. Here is a piece of code I'm using to test the idea.

  
  $dbh->{AutoCommit} = 0; 
  $dbh->{RaiseError} = 1;
  eval {
      $sql = "UPDATE stockhistory SET invoiced = 1 WHERE id = 737";
      $sth = $dbh->prepare($sql) or die "Cannot prepare: " . $dbh->err
+str();
      $sth->execute();
  };

  $dbh->commit ();

  if ($@) {
      print "Transaction aborted because $@";
      $dbh->rollback; 
  }
[download]

If I change the name of the database $@ shows an error (as you would expect) as does changing the field name 'invoiced' or 'id'.

However, if I change the id number to a number that does not exist in the db (say 1737), no error is shown even though it cannot have written that id number. Nothing changes in the db but the script carries on as if it has written successfully.

Can anyone tell me where I'm going wrong?

Hi All,

Currently I am using version 5.10, I have written so many perl scripts using lot of modules in this version.

Recently I try to install latest version 5.12. But most of the modules which I have installed in my previous version are all not available for this version.

For example, I have written many of my perl scripts using Perl/Tk module for GUI. But in the new version this module is not available, instead of that TKx is available. I dont think it supports my existing tools without modifying.

But I want to use my existing perl scripts without any modification. How can I install all my modules which I used with my previous version?

Thanks,

Srikrishnan

Fellow ``I love Perl so much, I can taste what Larry is having for dinner when I eat'' monks:

I pretty much always write my code in OO style, so that I never have to fear pissing on an imported name. In fact, most of my 'objects' are an empty shell. Essentially, I've standardized my coding style so that all opts/params *must* be name-based within an href, and that each sub call *must* be prefixed with either $obj-> or Class->

My tests are normally written about two lines ahead of the actual code it will be testing. Normally, each t/N-sub.t contains numerous code blocks, each block contains a single test I want to perform against the sub, eg:

# t/22-date.t
{ # date()
   
    my $obj = ISP::Object->new();
    my $ret = $obj->date();
    isa_ok( $ret, 'DateTime', "calling date() with no params, return" 
+);
}

{ # date() get param

    my $obj = ISP::Object->new();
    my $ret = $obj->date({ get => 'month' });
    ok( $ret =~ m{ \A \d{4}-\d{2} \z }xms, "called with get=>month wor
+ks out ok" );
}
[download]

I'm sick of duplicating code, especially within tests. I have mitigated some of this by wrapping the instantiation code within an internal sub, but now I have to carry globals:

{ # add_trace() trivial
   
    _reset();
   
    my $ret = $error->add_trace();
    is ( $ret, 0, "add_trace() returns success (0) when successful" );
}

{ # add_trace() type
   
    _reset();
   
    $error->add_trace();
    my $type = reftype $error->stack();
    is ( $type, 'ARRAY', "Error's stack trace is an array ref upon suc
+cess" );
}
[download]

I've heard that there are some modules that provide an oo and procedural interface. Although I haven't looked at any said code, what I'd like to do is instantiate an object via any method the class offers, perform only the task that method is supposed to, and return the result without having to build everything.

I'm wondering if each method should just call something else other than new() if $self isn't a reference. A basic 'what I'm thinking' is this (compacted for brevity ;) :

# in the package
sub new {
    my $class = shift;
    # suck in a config, bless and populate $self   
    return $self;
}
sub one_call_only {
    return bless {}, shift;
}
sub attach {
    my $thing  = shift;
    my $self   = ( ref $thing )
        ? $thing
        : $thing->one_call_only();
    # do attach() stuff with $self, and...:
    return $self->{ sub_details };
}
[download]

So, instead of manually instantiating a new object in my tests within each block (or if I want to use one method within an object) without having to perform the elaborate and time-consuming work that new() performs, I'm looking for other options.

fwiw, just for the `what I've tried' aspect, this is a basic routine that seems very simple. However, if I call it against the full-blown object, there are significant sanity checks performed, along with other self-building. That extra overhead is very cumbersome when trying to write tests.

sub attach {

    my $self    = shift;
    my $params  = shift;

    if ( $params->{ filename } && -e $params->{ filename } ) {

        my $filename    = $params->{ filename };
        my $mime_type   = mimetype( $filename );
            
        push @{ $self->{ attachments } },
          { Path => $filename, Type => $mime_type };
    }

    return $self->{ attachments }; # aoh
}
[download]

Feedback and pointers to other code very much welcome

Steve

Hi Perlmonks,

I studied C# and Java before.. and I HAVE NEVER confronted Regular Expression until I started learning Perl!!

I don't know if my brain is rusty or not, but I can hardly understand Regex.. How should I self-study Regex? Reading Perl related books might be helpful? or should I use websites? Is it okay for me to depend on Regex programs? I need your advice :3

Hey, I have a basic question on perl Fork. Once I start child process, I need the parent process to perform some action till the child process ends. I have tried using "until(waitpid)" but that doesnt work. Could someone help me out. Thanks! Here is the code..

FORK: {
    if ($pid=fork) {  ## parent process,no operation is performed here
    next;
    } elsif (defined $pid) {  ## Starting Fork, transfering data
         &download_a_file();
         exit 0;
    }
} 

until (waitpid ($pid,0) ) { 
## I need to perform some action only when child process is running
    &calculate_network_bandwidth();
} 
[download]

package Parent;
use Moose;

has 'knibbel' => (
    is => 'rw', 
    isa => 'HashRef[Maybe[Value]]',
    lazy_build => 1,
);
has 'knabbel' => (
    is => 'rw', 
    isa => 'ArrayRef[Maybe[Value]]',
    lazy_build => 1,
);

sub BUILD {
    my $self = shift;
    my $meta = $self->meta;
    print("BUILD called for " . __PACKAGE__ . "\n");
    no strict;
    foreach my $attribute ($meta->get_attribute_list) {
        print("Creating builder for attribute [$attribute]\n");
        *{__PACKAGE__ . '::_build_' . $attribute} = sub {
            my $self = shift;
            my $meta = $self->meta;
            my $fropsel = $meta->get_attribute($attribute);
            if ($fropsel->type_constraint->name =~ /^ArrayRef/) { retu
+rn []; }
            if ($fropsel->type_constraint->name =~ /^HashRef/) { retur
+n {}; }
        };
    }
    use strict;
}
1;
[download]

package Child;
use Moose;
extends 'Parent';

has 'knuisje' => (
    is => 'rw', 
    isa => 'Str',
    lazy_build => 1,
);

sub BUILD {
    my $self = shift;
    my $meta = $self->meta;
    print("BUILD called for " . __PACKAGE__ . "\n");
    no strict;
    foreach my $attribute ($meta->get_attribute_list) {
        print("Creating builder for attribute [$attribute]\n");
        *{__PACKAGE__ . '::_build_' . $attribute} = sub {
            my $self = shift;
            my $meta = $self->meta;
            my $fropsel = $meta->get_attribute($attribute);
            if ($fropsel->type_constraint->name =~ /^Str/) { return ""
+; }
        };
    }
    use strict;
}
1;
[download]

#!/usr/bin/perl -w
use strict;

use Parent;
use Child;

my $child = Child->new();
[download]

$ ./testchild.pl
BUILD called for Parent
Creating builder for attribute [knuisje]
BUILD called for Child
Creating builder for attribute [knuisje]
[download]

use strict;
use warnings;
use threads;
use threads::shared;

main();

sub main
{
    my @arr =
    (
        'ssh user@host rm -rf /cygdrive/mobile',
        'ssh user@host mkdir /cygdrive/mobile',
    );

    foreach my $key(@arr)
    {
        my $path = '/home/tart/tmp/';
        execute($path, $key);
    }
}


sub execute
{
    my $path = shift;
    my $cmd = shift;

    chdir($path) || die"Cant change patch $path\n";

    my $done :shared = 0;
    my @out;

    async {
            @out = `$cmd &`;
            if($?)
            {
                print "Error: $cmd\n";
            }
            $done = 1;
        }->detach;
    until($done)
    {
        for(1 .. 20 )
        {
            sleep 1;
            last if $done;
        }
        verbose($cmd);
    }

    print "@out\n";
}

sub verbose
{
    my $cmd = shift;

    print "Still executing: $cmd\n";
}

[download]

where, Commands are loaded into hash from .cfg (configuration file) and passed to subroutine where execution happens exactly like above. And error are passed into different subroutines,

sub execute
{
    my $infoHR = shift;
    my $setupHR = shift;
    my $path;
    my $command;

    $path       = $infoHR->{PATH}{$setupHR->{list}->{pth}};
    $command   = $infoHR->{COMMAND}{$setupHR->{list}->{cmd}};

    $path =~ s/^\s+//;
    $path =~ s/\s+$//;
    $command =~ s/^\s+//;
    $command =~ s/\s+$//;


    changeDirectory($path) || die "Unable to change dir to $path\n";
    my $done:shared = 0;
    my $failed:shared = 0;
    my @systemOut:shared;

    async {

            @systemOut = `$command 2>&1`;
            if($?)
            {
                $failed = 1;
            }
            $done = 1;
        }->detach;

    until($done)
    {
        for(1 .. 20 )
        {
            sleep 1;
            last if $done;
        }
            verbose(Running, $command);
    }

    unless($failed)
    {
            verbose(Success, $command);
            return 1;
    }

    return errFound($setupHR, Error $command);
}

[download]

 Scalars leaked: 1
[download]

SettingsDialog lets you add a simple settings dialog at the beginning of a Perl script, for showing and setting the arguments to the script. Before I attempt to submit this (my first module) to CPAN, please tell me what you think.

A picture might help, you can find one of a slightly older version of SettingsDialog here.

Typically to set up the dialog you write one line per variable, eg

- which would show a date picker labelled "Report starting date" in the dialog.

Variable "types" can be restricted to bool, int, date, color, file path, etc, and dropdown menus are shown for values to be selected from a list. Each variable can have a brief explanation beside it, which I personally need for scripts that I wrote more than six months ago and haven't run since.

Full docs are below. Thanks for your time, hope you enjoy.

the input, transformation and output of data

1. visual overview of complete data path from input to output
2. visual feedback on flow of data through various processing and decision elements
3. easy and implicit parallelism from the graph itself

I'm inviting your viewpoint on this issue, especially after looking at this job description:

Candidate should be fully proficient in writing scalable, high volume ETL jobs using SQL and Perl for large volume data warehouses

1. Resume execution of graph by setting watch points

I recently wanted to show the "up time" for a script in "nice" units. ApproxTime below is the result.

use warnings;
use strict;

printf "%9d seconds is about %s\n", $_, ApproxTime ($_)
    for 4, 250, 1.5e4, 4e5,  3e6, 12e6, 1.5e8;

sub ApproxTime {
    my ($period) = @_;
    my @periods = (
        ['seconds', 180,    60],
        ['minutes', 240,    60],
        ['hours',    48,    24],
        ['days',     16,     7],
        ['weeks',    10,     4.3482143],
        ['months',   30,    12],
        ['years'],
        );

    while ($periods[0][1] && $period > $periods[0][1]) {
        $period /= $periods[0][2];
        shift @periods;
    }

    $period = int $period;
    return "$period $periods[0][0]";
}
[download]

Prints:

        4 seconds is about 4 seconds
      250 seconds is about 4 minutes
    15000 seconds is about 4 hours
   400000 seconds is about 4 days
  3000000 seconds is about 4 weeks
 12000000 seconds is about 4 months
150000000 seconds is about 4 years
[download]

This has been tried (and done) many times before; it's almost a coming-of-age ritual. Heck, I've even done it myself before, long ago.

This is the way I feel like doing it today. What I don't like about it is that its performance is something like O(nm), where m is average number of parts in each path.

I'm sure there are better (for most definitions of "better") ways to do it; for example, tye suggested his Data::Diver module.

sub paths2tree
{
    my $hr = {};
    @{$hr}{@_} = map { {} } @_;
    my $n_repls;
    do
    {
        $n_repls=0;
        for ( sort { length($b) <=> length($a) } keys %$hr )
        {
            if ( /(.*)\\(.*)/ )
            {
                $hr->{$1}{$2} = delete $hr->{$_};
                $n_repls++;
            }
        }
    }
    while ( $n_repls );
    $hr
}

[download]

NB - This is hardcoded for the CP/M-style backslash path separator. You could generalize it if you want to. ;-)

Update: Upon reflection, I'm not sure you can get away from the O(nm) performance. At best, you can make the inner loop more efficient, e.g. by eliminating an explicit for loop and using a //g regex instead. (Not that I know how to do that in this case, however...)