I am trying to write a program that removes an entry from one of three lists. The program appears to work except the new files conf_list_* are empty except for the entries deleted. What am I missing?

#!/usr/bin/perl
use strict;
use warnings;

use File::Copy ("cp");

my $announce_off = "master_conf_list_announce_off";
my $announce_on = "master_conf_list_announce_on";
my $beep_on = "master_conf_list_beep_on";
my $date = &getDate;
my (%announce_off, %announce_on, %beep_on);

print "$date\n";
#create Backup files in the backup folder.  just incase anything goes 
+wrong.
cp ("./master_list/$announce_off", "./master_list/backup/$announce_off
+" . $date);
cp ("./master_list/$announce_on", "./master_list/backup/$announce_on" 
+. $date);
cp ("./master_list/$beep_on", "./master_list/backup/$beep_on" . $date)
+;

#create a scratch pad 
cp ("./master_list/$announce_off", "./master_list/$announce_off\.bak")
+;
cp ("./master_list/$announce_on", "./master_list/$announce_on\.bak");
cp ("./master_list/$beep_on", "./master_list/$beep_on\.bak");

#delete original files
unlink ("./master_list/$announce_off");
unlink ("./master_list/$announce_on"); 
unlink ("./master_list/$beep_on");

#open files for reading
open my $ANNOUNCE_OFFFH, '<', "./master_list/$announce_off\.bak";
open my $ANNOUNCE_ONFH, '<', "./master_list/$announce_on\.bak";
open my $BEEP_ONFH, '<', "./master_list/$beep_on\.bak";
open my $DELETE_LISTFH, '<', "$ARGV[0]";

#open files for writing
open my $ANNOUNCE_OFFNEW, '>>', "./master_list/$announce_off";
open my $ANNOUNCE_ONNEW, '>>', "./master_list/$announce_on";
open my $BEEP_ONNEW, '>>', "./master_list/$beep_on";
open my $DELETED_ITEMS, '>>', "./deleted_items.txt";


#slurp each file into hash
foreach (<$ANNOUNCE_OFFFH>){
    chomp($_);
    $announce_off{$_} = 1;
}

foreach(<$ANNOUNCE_ONFH>){
    chomp($_);
    $announce_on{$_} =1;
}
    
foreach(<$BEEP_ONFH>){
    chomp($_);
    $beep_on{$_} = 1;
}

#parse through the list to delete for items to delete
#print in either the old location or a liste of deleted files
foreach (<$DELETE_LISTFH>){
    chomp($_);
    print { exists $announce_off{$_} ? $ANNOUNCE_OFFNEW : $DELETED_ITE
+MS } $_ ."\n";
    print { exists $announce_on{$_} ? $ANNOUNCE_ONNEW : $DELETED_ITEMS
+} $_ ."\n";
    print { exists $beep_on{$_} ? $BEEP_ONNEW : $DELETED_ITEMS } $_ . 
+"\n";
}

close $ANNOUNCE_OFFNEW;
close $ANNOUNCE_ONNEW;
close $BEEP_ONNEW;
close $DELETED_ITEMS;

sub getDate(){
    my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    my(@weekDays) = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
    my($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $day
+OfWeek, $dayOfYear, $daylightSavings) = localtime();
    my($year) = 1900 + $yearOffset;
    my($theTime) = "\_$dayOfMonth\_$months[$month]\_$hour$minute";
    return $theTime;
}
[download]

Thanks for any assistance in advance.

sample URL: https://product-search.api.cj.com/v2/product-search?websit
+e-id=12345678keywords=GPS&serviceable-area=US 

and 

Sample Header:
https://product-search.api.cj.com/v2/product-search?website-id=1594990
+&keywords=%2Bsony+-camera

GET /v2/product-search?website-id=1594990&keywords=%2Bsony+-camera HTT
+P/1.1
Host: link-search.api.cj.com
User-Agent: Mozilla/5.0 (Windows; U; Windows NT 6.0; en-US; rv:1.9.0.8
+) Gecko/2009032609 Firefox/3.0.8
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.
+8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip,deflate
Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7
Keep-Alive: 300
Connection: keep-alive
Cookie: __utma=128446558.2099392322683464700.1239639722.1239639722.123
+9927095.2; __utmz=128446558.1239639722.1.1.utmcsr=(direct)|utmccn=(di
+rect)|utmcmd=(none); CONTID=8073; cjuMember=0; JSESSIONID=aM5RSWdqdd_
+5
Authorization: YOUR DEV KEY HERE

HTTP/1.x 200 OK
Server: Resin/2.1.17
Content-Type: application/xml
Transfer-Encoding: chunked
Date: Thu, 26 Apr 2009 10:25:03 GMT
[download]

sudo perl -MCPAN -e 'install Net::SFTP'
or
yum install ...
[download]

 $ perl -lwe '"abbbbc"=~/(b+)/ && print "Found: $1"'
Found: bbbb
 $ perl -lwe '"abbbbc"=~/(b*)/ && print "Found: $1"'
Found:
[download]

use v6;

my $file = open 'scores';
my @names = $file.get.split(' ');

my %matches;
my %sets;

for $file.lines -> $line {
        my ($pairing, $result)  = $line.split(' | ');
        my ($p1, $p2)           = $pairing.split(' vs ');
        my ($r1, $r2)           = $result.split(':');

        %sets{$p1} += $r1;
        %sets{$p2} += $r2;

        if $r1 > $r2 {
                %matches{$p1}++;
        } else {
                %matches{$p2}++;
        }
}

my @sorted = @names.sort({ %sets{$_} }).sort({ %matches{$_} }).reverse
+;

for @sorted -> $n {
        say "$n has won %matches{$n} matches and %sets{$n} sets";
}
[download]

Beth Ana Charlie Dave
Ana vs Dave | 3:0
Charlie vs Beth | 3:1
Ana vs Beth | 2:3
Dave vs Charlie | 3:0
Ana vs Charlie | 3:1
Beth vs Dave | 0:3
[download]

Method 'split' not found for invocant of class ''
  in <anon> at line 12:type.p6
  in main program body at line 1
[download]

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

I was thinking about an old node of mine the other day, and got to pondering Perl's object system in general. I came to the conclusion that it's much better than it gets spoken of.

Most people coming to Perl's object system have already done object-oriented programming in one or more other languages. They know how it works, and what objects are. A typical thought on what an object is probably is something like this:

An object is a set of functions that know what data they are to operate on.

This is a decent, usable, understanding of what an object is. It is also subtly wrong. An object is:

An object is a set of data that knows what functions operate on it.

The difference is subtle, but quite important for understanding objects in Perl. In most languages, you get a set of dedicated grammar for defining the object, the data that is in it, and the functions that are related to it. Perl has cut these to an absolute minimum. In fact, Perl gets by with just a handful of words, and one new calling syntax:

• bless()
• SUPER
• DESTROY()
• overload

And the syntax: (I'm ignoring indirect syntax, as generally a bad idea.)

$foo->bar();  # The same as: 'bar($foo);' in the package $foo is blessed into.

That, for all normal intents and purposes, is it. (I could be missing something. Also, SUPER might be usable outside an object.) Everything that other languages do with private, public, property, etc. are all done using the above and other already existing features of the Perl language.

The most important one, and the one where that subtly-wrong definition will bite you, is bless(). It marks a reference to a set of data as being of an object. The functions that operate on this data are the functions in a specific package. (Defaulting, of course, to the current package.)

Note that Perl's packages are used for other things: They are the normal way to group related functions together. They can be used to limit scope, or to help organize code. Many many modules simply export functions from their own package into the calling package upon demand. So that grouping is not part of Perl's object system. It is part of Perl.

Also, there is no imposed structure on the reference that has been blessed. It can be any reference, of any type, and can be as complicated as you want it to be. (I haven't actually tried bless()ing a code reference, but I suspect it would work...) Perl allows references to point to structures that contain other references, so you can have arbitrary complexity, if you want it. You can also use that reference as a key into some other data structure(s), allowing for even more options.

This leads to some simple points: If the reference is directly to the data, then anyone can access that data through that reference. This is the same as 'public' data in many other languages. (With the same pros and cons.) If data is accessed via using the reference as a key into some other data structure, then the data is as private as that data structure. It can be 'protected' or 'private', as the case depends. Since the reference can contain data structures, the actual data can be stored in ways that allow all of the above, within a single class. All of this with one word of syntax, and the data storage techniques you already know!

Which brings the next point: Some of that data might be more important that other data. Or larger, harder to access, or need to be accessed more often, or... This isn't a problem for Perl, because object data is handled using the same tools as any other data. You need it done one way? Do it that way. You have the whole language to work with.

This 'object data is regular data, just marked as part of an object' extends into the one real syntax: the calling syntax. All it really does is say which package to look in for the function, and implies that the function gets one extra piece of data, your reference.

So, object functions are regular functions. You can even call them as regular functions, if you pass them the correctly-structured arguments.

There is no conceptual difference, in Perl, between anything that is an object, and anything that isn't. Data is data. Functions are functions. The programmer is free to do what they like with them. Objects are a way to organize code.

You want a singleton object? Just return the same data reference every time. You want a pool of objects? Keep a group of references, and alternate between them as you want. You want people to be able to access your data directly? Give it to them in the reference. You want to protect it? Have the reference point to a key for another data structure, that you keep hidden.

You want to be able to string object method calls to infinity? Ok, have them return their blessed reference. You want easy mutators for specific data elements? Simple enough to write.

Once I started to think about it, I realized the 'cryptic' OO-system in Perl isn't cryptic at all. It is just enough to make sure you can do anything you want, and nothing to get in your way.

It's beautiful. It's simple. It's powerful. It's Perlish.

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]