Re: regex help
Tony Heal am Dienstag, 21. August 2007:
-Original Message-
From: Chas Owens [mailto:[EMAIL PROTECTED]
Sent: Tuesday, August 21, 2007 9:50 AM
To: [EMAIL PROTECTED]
Cc: beginners@perl.org
Subject: Re: regex help
On 8/21/07, Tony Heal [EMAIL PROTECTED] wrote:
Here is a sample of the versions that I am using.
snip
Just to clarify, you have a version string with the following format:
{major}{custom tag}.{minor}-{build}
and you want the list sorted by major, then minor, then build.
#!/usr/bin/perl
use strict;
use warnings;
my @versions;
while (DATA) {
chomp;
die invalid format unless
my ($major, $minor, $build) =
/(\d+)(?:-.+)?\.(\d+)-(\d+)/; push @versions, [ $major, $minor, $build ,
$_];
}
print $_-[-1]\n for sort {
$a-[0] = $b-[0] or
$a-[1] = $b-[1] or
$a-[2] = $b-[2]
} @versions;
__DATA__
16.1-17
[snip]
16-special.4-10
16-special.5-1
16-special.5-2
16-special.6-6
Hello Tony
Just include the original line in the die message to see what caused it (an
empty line would for example).
Based on that, you can then adapt the regex.
OK I added this and I keep getting invalid format
foreach (@newValues){print $_\n;}
my @versions;
while (@newValues)
{
chomp;
die invalid format unless
die invalid format of '$_' unless
my ($major, $minor, $build) = /(\d+)(?:-.+)?\.(\d+)-(\d+)/;
push @versions, [ $major, $minor, $build , $_];
}
foreach (@versions){print $_\n;}
}
/tmp# ./trim.pl
14.20-33
[snip]
14.16-31
invalid format at ./trim.pl line 41. (41 is the die line)
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Remove a specific element from an Array
Sumit am Montag, 9. Juli 2007 09:43:
Hey Guys,
Hi Sumit
I am a new bie to this Group.
I have a Problem.
I want to remove an element from an array whose index i dont know.
---
#!/usr/bin/perl -w
use strict;
use warnings; # additionaly
my @updateNames = ();
my @tempArr = ();
my $item = ;
my $item2 = ;
push @updateNames,I_love_you;
push @updateNames,I_love_you_too;
push @updateNames,I_hate_you;
push @tempArr,I_love_you;
push @tempArr,I_love_Him;
push @tempArr,I_hate_you;
# This can be shortened, avoiding all the pushs:
my @updateNames = qw( I_love_you I_love_you_too I_hate_you );
my @tempArr = qw( I_love_you I_love_Him I_hate_you );
# my ($item1, $item2); == better declared locally in the loops below
foreach $item (@updateNames)
foreach my $item (@updateNames) # etc.
{
foreach $item2 (@tempArr)
{
if ($item eq $item2)
{
pop @updateNames,$item; #This pop is just removing the
last element i want to remove $item2 from @updateNames
}
}
}
# You want to remove all elements from @updateNames that are contained
# in @tempArr. To avoid a lot of array traversing,
# it's better to use a hash as indexing data structure.
# I use the grep function to extract only the wanted elements out of
# @updateNames.
#
# The above nested loops would then be replaced by:
my %index = { map $_ = 1 } @tempArr;
@updateNames = grep !exists $index{$_}, @updateNames; # see perldoc -f grep
print \n;
foreach $item (@updateNames)
{
print $item;
print \n;
}
print $_, \n for @updateNames;
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Help needed created this data structure
klute am Montag, 9. Juli 2007 23:04:
--- Chris Charley [EMAIL PROTECTED] wrote:
- Original Message -
From: klute [EMAIL PROTECTED]
Newsgroups: perl.beginners
To: beginners@perl.org
Sent: Monday, July 09, 2007 4:20 PM
Subject: Help needed created this data structure
Hi All,
I am new to Perl and was hoping to get advice on
creating the following data structure:
I have an Affiliate Parent Groups, Affiliate
Groups,
and Affiliates. Each affiliate has affiliateId,
affiliateName.
I guess what I'd like to have is an array of
hashes
where the array would contain Affiliate Parent
Groups.
Each item in the array would contain a hash map
with
Affiliate Group name as the key and An array of
Affiliates (each having AffiliateId and
AffiliateName)
as the value.
How would I go about creating such structure and
adding values to it in a loop?
Any help will be greatly appreciated!
James
Its hard to see what structure you want without some
sample data.
Send some data as it is in the file.
Have you tried any coding yet?
Chris
Hi Chris,
I did try coding this but I am afraid to confuse
everyone with what I came up with so far. I can paste
what I have if you feel that it would help.
Here is the sample data:
Affiliate Parent Group: Google
- Affiliate Group: Google Advertiser
-- Affiliate (Aff Id: 1, Aff Name: Frank)
-- Affiliate (Aff Id: 2, Aff Name: Mary)
- Affiliate Group: Google Publisher
-- Affiliate (Aff Id: 3, Aff Name: Lori)
-- Affiliate (Aff Id: 4, Aff Name: Mike)
Affiliate Parent Group: Yahoo
- Affiliate Group: Yahoo Advertiser
-- Affiliate (Aff Id: 5, Aff Name: Marlene)
-- Affiliate (Aff Id: 6, Aff Name: Larry)
- Affiliate Group: Yahoo Publisher
-- Affiliate (Aff Id: 7, Aff Name: Alex)
-- Affiliate (Aff Id: 8, Aff Name: Glenn)
Hello Klute
(please don't top post to keep the conversation readable)
The following script extracts the information out of your sample data.
There are no checks if the data format is correct (nesting order, additional
text).
It does not result in an array of hashes, but in a single hash.
Modify it if needed :-)
Dani
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my %data;
# holds the current first and second level
#
my ($parent_group, $aff_group);
while (DATA) {
# a loop block, so we can use next
{
# skip blank lines
/^\s*$/
and next;
# record current first level
/^A.*?: (.*)/ and $parent_group=$1
and next;
# record current second level
/^\s+-.*?: (.*)/ and $aff_group=$1
and next;
# fill %data, with completed three levels
/--.*?: (\d+).*?: (\w+)/
and $data{$parent_group}{$aff_group}{$1}=$2;
}
}
print Data::Dumper::Dumper \%data;
__DATA__
Affiliate Parent Group: Google
- Affiliate Group: Google Advertiser
-- Affiliate (Aff Id: 1, Aff Name: Frank)
-- Affiliate (Aff Id: 2, Aff Name: Mary)
- Affiliate Group: Google Publisher
-- Affiliate (Aff Id: 3, Aff Name: Lori)
-- Affiliate (Aff Id: 4, Aff Name: Mike)
Affiliate Parent Group: Yahoo
- Affiliate Group: Yahoo Advertiser
-- Affiliate (Aff Id: 5, Aff Name: Marlene)
-- Affiliate (Aff Id: 6, Aff Name: Larry)
- Affiliate Group: Yahoo Publisher
-- Affiliate (Aff Id: 7, Aff Name: Alex)
-- Affiliate (Aff Id: 8, Aff Name: Glenn)
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Text munging problem
John W. Krahn am Samstag, 7. April 2007 01:05:
D. Bolliger wrote:
Chas Owens am Freitag, 6. April 2007 13:27:
[snip
$ perl -e'
use Benchmark q[cmpthese];
my $wordlist = qx[cat /usr/share/dict/words];
cmpthese -10, {
twomaps = q{ join , map ucfirst, map lc, split , $wordlist },
onemap = q{ join , map ucfirst( lc ), split , $wordlist },
subst = q{ ( my $x = $wordlist ) =~ s/(\S+)/\L\u$1/g; $x },
};
'
Rate twomaps onemap subst
twomaps 1729492/s ---13%-38%
onemap 1981233/s 15% ---30%
subst 2811473/s 63% 42% --
Hmm... quite impressive... I didn't expect substitution to be so performant.
Seems that expectations are not the best replacement for benchmarking :-)
btw, nice test! Thanks, John
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Text munging problem
Glenn Booth am Donnerstag, 5. April 2007 23:10: Hi All, Hi Glenn I'm a two-week perl newbie, trying to get my head around text handling. I keep getting sent badly formatted text files, which I have to 'repair' so that I can use them to feed an Oracle database. They are typically a few thousand lines long. The files generally arrive in a format like this: serial_number | TITLE OF SOMETHING | free text description | price | For example: 0097138 | BOOK TITLE | A book about dogs | 4.99 | 0098102 | different book title | small blue book about cats | 2.99 | I need to sort out the cases of the text fields (BOOK TITLE) and ( a book about cats ) and render them to Title Case (first character upper case for each word). So my example would become: 0097138 | Book Title | A Book About Dogs | 4.99 | 0098102 | Different Book Title | Small Blue Book About Cats | 2.99 | I have an awk solution, but since I want to learn Perl... My failed approach so far: While loop to read file line by line Split each line using delimiter (pipe in this case) Put the text fields into an array Shift each element out of the array Run a regex to upper case the first character Shift element back into array I made a horrible mess, and it didn't work. I also tried using substr() to isolate the first character then uc() it, lc() the rest of the string and then concatenate the result. Even uglier, and it still didn't work. Anyone have an elegant way? What about (tested with sample data): $ perl -nle 'print join , map ucfirst, map lc, split' in.txt out.txt perldoc perlrun # for -nle perldoc -f [map|ucfirst|lc|split] Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: Text munging problem
Chas Owens am Freitag, 6. April 2007 13:27:
On 4/6/07, D. Bolliger [EMAIL PROTECTED] wrote:
$ perl -nle 'print join , map ucfirst, map lc, split' in.txt
out.txt
There is no need to have multiple maps and the @ARGV/ trick handles
files as well as stdin, so there is no need to use
perl -lne 'print join , map { ucfirst lc } split' in.txt out.txt
You're right of course; your corrected version is not only more elegant and
perlish, but also - what a surprise ;-) - significantly faster.
(I wondered how much:
Rate twomaps onemap
twomaps 13003/s ---26%
onemap 17668/s 36% --
including assignement of the test data to $_ for split (~125/s),
excluding print)
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Calling bash things inside perl script.
Nath, Alok (STSD) am Dienstag, 3. April 2007 07:03: Hi, Before starting my problem I just want to thank all the active members who had literally mentored me in learning perl. I have bunch of this bash scripts which has lot of functions. I wanted to call and use them in a perl script.I am not sure how to do this.I did a cpan search but did not find anything helpful. Any idea how to do this ? Hello Alok There are several possibilities (you'll find a lot of examples searching the list archive) - which one is appropriate depends on how complex the interaction with the external scripts should be: perldoc -q command # some faqs perldoc -f qx # refers to longer doc perldoc -f system perldoc IPC::Run2 perldoc IPC::Run3 perldoc -f open# for pipes # and eventually: perldoc perlipc# bidirectional communication etc. perldoc -f exec perldoc -f fork I'm sure there are others, including howtos. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: Calling bash things inside perl script.
D. Bolliger am Dienstag, 3. April 2007 07:56: Nath, Alok (STSD) am Dienstag, 3. April 2007 07:03: Hi, Before starting my problem I just want to thank all the active members who had literally mentored me in learning perl. I have bunch of this bash scripts which has lot of functions. I wanted to call and use them in a perl script.I am not sure how to do this.I did a cpan search but did not find anything helpful. Any idea how to do this ? [snipped my answer] Again hello, With call them you referred to the functions, not the scripts, as I realize from the example you posted... I'd learn something new if it is possible to call bash functions directly from within perl :-) (and you can't export bash functions to the parent process anyway) I think you need to write some bash wrapper scripts that call your functions, so that it is possible to call them [the wrapper scripts ;-)] (and interact via stin/stout/stderr) from within perl. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: Exiting loops
Karyn Williams am Donnerstag, 29. März 2007 20:27:
[snip]
It varies greatly. Often one or two. Sometimes 70. The size of the files is
fairly substantial:
-rw-r--r-- 1 root other249595095 Sep 1 2006 maillog.200608
I am getting Out of memory errors while running the script.
[snip]
I have hashed and slurped files in other scripts. I could try it here and
see what happens.
[snip]
open MAILLOG,
/export/home/archives/maillog.$flist[1] or die
couldn't open maillog.$flist[1] : $!\n;
if ($count = grep /user=$k/o, MAILLOG ) {
print $k checked mail $count times in
maillog.$flist[1].\n; next ;
} else {
close MAILLOG;
[snip]
Hello Karyn
(Didn't quite got the overview: Formatting, combined top/inline posting,
unstripped postings. So the following may be inappropriate)
Try to read the logfiles line per line (instead of slurping the whole log file
into memory), using a while loop, along the lines:
while (MAILLOG) {
# handle log line (contained in $_) here
}
# handle result of parsing the whole file here
This will use minimal memory resources.
# ./tt.pl karyn smurphy root
karyn checked mail 2864 times in /var/adm/maillog.
smurphy checked mail 2864 times in /var/adm/maillog.
root checked mail 2864 times in /var/adm/maillog.
#
Yes, it goes to the next arg but as you can see, it returns the same count
for each subsequent arg.
The reason for this probably is the o modifier in /user=$k/o regexes: this
will fix the value of $k within the regex. Try to define a precompiled regex
every time $k changes - this will compile a regex once for every different
value of $k:
# value assigned to $k here
my $regex=qr/user=$k/;
# ...
$variable=~/$regex/ count++;
This is the alternate way to speed up matching.
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Add directories to @INC
Lee Conine am Montag, 26. März 2007 16:03: Hello (just noted Tom Phoenix's answer with the hint to perlfaq8 after writing, but sending anyway...) I see that there are a lot of people wanting to know how to add directories to their @INC permanently. I accomplished this by adding the following line to the end of my startup.pl file: push(@INC, Put path to directory here); This appends the new library path to @INC. The usual method however is to prepend it to @INC, so the added paths are searched first. That would lead to unshift @INC, 'Put path to directory here'; Which is better expressed by (see perldoc lib) use lib 'Put path to directory here'; Since the startup script unter mod_perl is also used to preload modules - including your own, located in nonstandard paths - a better place to put it is the beginning of the startup script, as you usually put use libs at the beginning of non-mod_perl scripts and modules. And there is a PERL5LIB env variable too that can be populated with additional library paths and exported, f.e. export PERL5LIB=/opt/osf/lib:/opt/smf/lib:/opt/my_perl/lib so you don't have to change scripts or modules (by placing use libs in it). Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: private method
Jeff Pang am Sonntag, 4. März 2007 08:35: by convention any function, variable, or hash key that begins with an underscore, '_', is considered to be private. Seems not useful. [ example snipped] Hello Jeff Chas referred to a _convention_ - which does not enforce privacy. IMO it's useful, otherwise it would not be widely used, and for example, Test::Pod::Coverage would require subroutines starting with an underscore to be documented. :-) Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: Record separator and regex switch
Beginner am Montag, 26. Februar 2007 14:50:
Hi,
Hi
I am trying to parse some dhcp-lease files to extract the ip, mac and
hostname.
I am struggling to get either, the regex of the $/, correct. I am not
sure which combination of these I should use.
There is some sample data and my best effort below. Can anyone offer
any pointers?
TIA,
Dp.
=== Sample Data =
[moved to __DATA__ section below]
== My effort ===
#!/usr/bin/perl
use strict;
use warnings;
my $file = '/var/lib/dhcp3/dhcpd.leases';
my ($ip,$mac,$host);
#$/ = }\n;
used below :-)
$/ = '';
open(FH,$file) or die Can't open $file: $!\n;
while (FH) {
chomp;
($ip,$mac,$host) = ($_ =~
/lease\s+(\d{3}\.\d{3}\.\d{3}\.\d+).*thernet\s+(\d{2}:\d{2}:\d{2}:\d{2
}:\d{2}:\d{2}).*ostname\s+\
(\w+\.scien.*)/smg);
print $ip $mac $host\n;
}
To keep the demonstration script short, I use a short regex that should be
more specific
#!/usr/bin/perl
use strict;
use warnings;
{
local $/=}\n;
for (DATA) {
my ($ip,$mac,$host)=
/lease\s+(\S+).*
ethernet\s+(\S+);.*
hostname\s+(\S+);
/sx;
print IP $ip - MAC $mac - HOST $host\n;
}
}
__DATA__
lease 196.222.237.209 {
starts 5 2007/02/23 17:53:57;
ends 6 2007/02/24 17:53:57;
binding state active;
next binding state free;
hardware ethernet 00:60:04:28:28:01;
client-hostname lab.mydomain.com;
}
lease 196.222.237.209 {
starts 5 2007/02/23 17:53:57;
ends 6 2007/02/24 17:53:57;
binding state active;
next binding state free;
hardware ethernet 00:60:04:38:38:01;
client-hostname lab.mydomain.com;
}
lease 196.222.237.195 {
starts 5 2007/02/23 17:54:04;
ends 6 2007/02/24 17:54:04;
binding state active;
next binding state free;
hardware ethernet 00:0c:c1:33:31:0d;
uid \001\000\014\361\3231\015;
client-hostname puck;
}
8
IP 196.222.237.209 - MAC 00:60:04:28:28:01 - HOST lab.mydomain.com
IP 196.222.237.209 - MAC 00:60:04:38:38:01 - HOST lab.mydomain.com
IP 196.222.237.195 - MAC 00:0c:c1:33:31:0d - HOST puck
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Record separator and regex switch
Beginner am Montag, 26. Februar 2007 17:02:
On 26 Feb 2007 at 15:58, D. Bolliger wrote:
Beginner am Montag, 26. Februar 2007 14:50:
Hi
I am trying to parse some dhcp-lease files to extract the ip, mac and
hostname.
I am struggling to get either, the regex of the $/, correct. I am not
sure which combination of these I should use.
There is some sample data and my best effort below. Can anyone offer
any pointers?
=== Sample Data =
lease 196.222.237.209 {
starts 5 2007/02/23 17:53:57;
ends 6 2007/02/24 17:53:57;
binding state active;
next binding state free;
hardware ethernet 00:60:04:28:28:01;
client-hostname lab.mydomain.com;
== My effort ===
#!/usr/bin/perl
use strict;
use warnings;
my $file = '/var/lib/dhcp3/dhcpd.leases';
my ($ip,$mac,$host);
#$/ = }\n;
used below :-)
$/ = '';
open(FH,$file) or die Can't open $file: $!\n;
while (FH) {
chomp;
($ip,$mac,$host) = ($_ =~
/lease\s+(\d{3}\.\d{3}\.\d{3}\.\d+).*thernet\s+(\d{2}:\d{2}:\d{2}:\d{2
}:\d{2}:\d{2}).*ostname\s+\
(\w+\.scien.*)/smg);
print $ip $mac $host\n;
}
[snipped]
Thanx Dani,
That's worked a treat. Just to complete the learning curve, where was
I going wrong?
That should have been part of my first answer, sorry. I'll try and hope I
don't mess with the test versions and the english language :-)
Looking at the regex:
It only matches MACs without a-c hex digits (and there's no 'scien' string in
the data, but that's probably due to the altered hostnames, and I assume that
the \d{3} in the IP matching part is intended.).
In the script version with $/ = '':
This reads all records at once, and this seems to be the reason why you used
the /g modifier. But then, after matching the IP of the first lease, the
first .* will skip all leases except the last one for the mac/host matching.
So you (or I respectively) get a single wrong result with the IP of the
first lease and mac/host of the last lease (after correcting the mac regex
part).
So you would have to alter the .* into the non-greedy .*? (to avoid
skipping leases) and also append a .*? at the end of the regex to match what
is between the leases [argh!] (to avoid only one match).
But even if the regex is correct, and the ip/mac/host of every lease is
matched, only the first 3 captured matches get stored into ($ip,$mac,$host),
and the others are discarded (which would not be the case with
@data=/../g).
When you tried with $/ = }\n:
I don't know neither how the regex looked like in this case, nor what went
wrong then, so I can't say much.
Other notes:
The $_=~ is not necessary, because if the left side of =~ is missing, $_ is
used by default.
To read all leases, you could also do it like so to avoid the somehow
misleading while loop:
{
local $/; # sets $/ to undef
my $data=FH; # slurp entire file
# ...match with /g modifier...
}
chomp is not necessary.
Hope that covers the most important issues :-)
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: BInding operator fails
[EMAIL PROTECTED] am Montag, 26. Februar 2007 18:49:
[snip]
Hi!
use strict;
use warnings;
my $rdns=cn=Exchange Sites,cn=Proxy Views,cn=JoinEngine
Configuration,ou=Conf,o u=InJoin,ou=applications,dc=marriott,dc=com;
my $result=cn=Exchange Sites;
if ($result !~ /\Q$rdns\E/six) {
print \nresult: '$result';
print \nrdn: '$rdns'\n;
} else {
print String is there\n;
}
OUTPUT is:
$ ./test.pl
result: 'cn=Exchange Sites'
rdn: 'cn=Exchange Sites,cn=Proxy Views,cn=JoinEngine
Configuration,ou=Conf,ou=InJoin,ou=applications,dc=marriott,dc=com'
Tom your code works fine. But I was tring to understand why !~ fails
above.
[snip]
The regex expression tries to match $rdns in $result, and not the reverse way,
and of course you can't find a long string in a shorter one, even not if the
shorter one is contained in the longer one.
So $rdns is never matched in $result, and since you ask if it does *not*
match, the result is always true, and the else branch is never hit.
Dani
P.S.:
Please open a new thread when asking a new question, and answer inline or at
the bottom, not a the top, thx :-)
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: converting to mixed case
jm am Montag, 26. Februar 2007 18:54:
Hi
is there a function, module, script, etc. that converts all uppercase to
proper mixed case. this particular need is for an address list that is all
uppercase
This description of what you want to achieve does not correspond to the
example below; you also add '.'s and a space, and 'OK' is still non-mixed
case.
1370 W 14TH ST
ADA,OK
74837
i would like to convert it to
1370 W. 14th St.
Ada, OK
74837
you can try to fiddle around with ucfirst and lc, see:
perldoc -f ucfirst
perldoc -f lc
however, some exceptions are to be handled as well as the format kept...
(therefore the map chain below)
The following does some of the tasks (I did not search google...):
#!/usr/bin/perl
use strict;
use warnings;
my $s=
1370 W 14TH ST
ADA,OK
74837
;
print map ucfirst,
map {$_ eq ',' ? ', ' : $_} # handle special case
map {$_ eq 'OK' ? $_ : lc $_ } # dito, instead of unconditional lc
($s=~/(\w+)(\W+)/g); # not very sophisticated :-)
__END__
1370 W 14th St
Ada, OK
74837
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: out of memory problem
Arantxa Otegi am Mittwoch, 14. Februar 2007 12:37:
I have memory problems programming with perl: out of memory!
I have to process a lot of xml files which are in different directories
(more than 2 files in 110 directories). The files are quite small
(almost all of them are smaller than 100KB).
Here is some code:
[snipped main script]
package Expansion;
use strict;
use XML::DOM;
$| = 1;
sub fitx_expansioa{
my $sarfitx;
my $irteera_fitx;
my %variantak;
my $portzentaia;
($sarfitx,$irteera_fitx,$portzentaia,%variantak) = @_;
my $dom_parser = new XML::DOM::Parser;
my $dok = $dom_parser-parsefile($sarfitx);
//XML process
...
my $irteeraXML = $dok-toString;
$dok-dispose;
open(I,$irteera_fitx) or die Ezin da ireki $irteera_fitx: $!;
print I $irteeraXML;
close I;
}
Hello Arantxa Otegi
Maybe not of much help or directly related to your problem, but you may
consider using XML::LibXML instead of XML::DOM. It is much faster and
consumes less memory (but try Ken Foskeys tip first).
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Dynamically calling a subroutine
Ana Saiz García am Dienstag, 13. Februar 2007 13:02:
On 12/02/07, D. Bolliger [EMAIL PROTECTED] wrote:
Ana Saiz García am Montag, 12. Februar 2007 22:26:
[snipp and following code stripped]
#!/usr/bin/perl
# don't forget:
#
use strict;
use warnings;
package A;
sub hello { print hello from A\n }
package main;
my $pkg='A';
my $sub=\{$pkg.'::hello'};
$sub-();
__END__
Hi again and thanks for your help
Don't I have to put use and the name of packages A and B anywhere on the
main program?
Not if the package declarations are in the same file as the main package; in
most cases the modules are in separate files, and then 'use' is necessary to
read, and compile the files with the module (package) definitions.
See perldoc -f use.
Therein is explained that 'use Module' is equivalent to
BEGIN { require Module; import Module LIST; }
perldoc -f require
perldoc Exporter # defines the import() method mentioned above
'use' searches for modules in the paths defined in the @INC variable (see
perldoc perlvar) which can be modified directly or (preferred) via the lib
pragma:
use lib '/some/path'; # see: perldoc lib
regards,
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: DOS to Windows format tr/\n\r\t/ /
[EMAIL PROTECTED] am Montag, 12. Februar 2007 14:11: I am not sure I understand the problem, but do you know the Text::Wrap standard module in any case? I used it on Unix, but I'm not sure it runs on my DOS version. Sounds as if it might be worth trying. It won't hurt your box if it doesn't. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: pattern match
Vladimir Lemberg am Montag, 12. Februar 2007 21:33:
Hi,
Hi Vladimir
(in addition to Davids post)
I have a script, which suppose to find all *.xml files under the specified
directory then process them. I'm facing the pattern match problem:
use strict;
use warnings;
use Win32;
use File::Find;
@ARGV = Win32::GetCwd() unless @ARGV;
my @dirs;
find (\FindXml, $ARGV[0]);
sub FindXml
{
return if !stat || -d;
( my $xml_file = $File::Find::name ) =~ /^.+\.xml$/;
push ( @dirs, $xml_file );
}
In this examples the pattern match /^.+\.xml$/ is not working and
The pattern match _is_ working, but the effekt is not the desired one :-)
In this line, you first assign (unconditionally) $File::Find::name to
$xml_file. Then a match is tried, giving a true or false result that is
_not_used_. That's the reason why:
all files
regardless of the extension have been assigned to $xml_file variable.
#
However, if I change parenthesis to count the matching, the pattern seems
to work.
sub FindXml
{
return if !stat || -d;
my $xml_file = ( $File::Find::name =~ /^.+\.xml$/ );
print $xml_file;
}
Here, $xml_file will have a boolean value, despite of the variable name.
Hope this explanation is useful (and correct),
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Dynamically calling a subroutine
Ana Saiz García am Montag, 12. Februar 2007 22:26:
Hello
Hello Ana
First of all, I apologize if this is not the right list to ask my question,
but as I am a perl beginner, I think it is the most suitable list for me
:o)
So here goes my question:
I have a main program which will call a subroutine, say S, belonging to
another module. The question is that there could be several modules that
contain a subroutine also named S, which basically will return equivalent
values to the main program.
My problem is that I don't want to harcode the name of those modules (for
example using an if), because I don't know a priori how many there will
be or which will be needed to call at any moment. The idea is that there
will be a file in which the main program could read which module is
necessary in each moment, and so call it.
So the question is: Is there any way to call a subroutine without
explicitly writing his name?
Thanks in advance, and if I haven't been able to explain it well, please
ask me :o)
Hm, one way would be to use subroutine typeglobs. In the following
demonstration code, all modules are included into the main script for
shortness.
You can find information in
perldoc perldata
(Typeglobs and Filehandles) - don't know of other resources at the moment.
#!/usr/bin/perl
# don't forget:
#
use strict;
use warnings;
package A;
sub hello { print hello from A\n }
package B;
sub hello { print hello from B\n }
# implicit namespace in main scripts;
# only needed here because of the package declarations above
#
package main;
# can be got via cmdline or whatever source
#
my $pkg='A';
# we get the wanted sub via a subroutine type glob at runtime...
#
my $sub=\{$pkg.'::hello'};
# ...and call it indirectly
#
$sub-();
__END__
Hope this helps!
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: pattern match
Mumia W. am Montag, 12. Februar 2007 21:53:
On 02/12/2007 02:33 PM, Vladimir Lemberg wrote:
Hi,
I have a script, which suppose to find all *.xml files under the
specified directory then process them. I'm facing the pattern match
problem:
use strict;
use warnings;
use Win32;
use File::Find;
@ARGV = Win32::GetCwd() unless @ARGV;
my @dirs;
find (\FindXml, $ARGV[0]);
sub FindXml
{
return if !stat || -d;
( my $xml_file = $File::Find::name ) =~ /^.+\.xml$/;
push ( @dirs, $xml_file );
}
In this examples the pattern match /^.+\.xml$/ is not working and all
files regardless of the extension have been assigned to $xml_file
variable. [...]
You probably want to push the filename onto the array if you get a
successful match:
sub FindXml
{
return if !stat || -d;
( my $xml_file = $File::Find::name ) =~ /^(.+\.xml)$/;
push ( @dirs, $xml_file ) if $1;
}
[snipped]
Mumia,
This will not behave as expected because a test is missing if the match was
successful. I mention it mainly because it's a common error that is not easy
to detect at first glance :-)
Test script demonstrating the issue:
#!/usr/bin/perl
use strict;
use warnings;
my $pat='a';
for (qw/ a b c d/) {
(my $x=$_)=~/(^$pat$)/;
print Found $pat in /$_\n if $1;
}
__END__
# Output is:
Found a in a
Found a in b
Found a in c
Found a in d
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
[Correction] Re: pattern match
D. Bolliger am Montag, 12. Februar 2007 23:03:
Mumia W. am Montag, 12. Februar 2007 21:53:
On 02/12/2007 02:33 PM, Vladimir Lemberg wrote:
[snipped]
Mumia,
please excuse me for my inappropriate correction!
You probably want to push the filename onto the array if you get a
successful match:
sub FindXml
{
return if !stat || -d;
( my $xml_file = $File::Find::name ) =~ /^(.+\.xml)$/;
push ( @dirs, $xml_file ) if $1;
}
[snipped]
Mumia,
This will not behave as expected because a test is missing if the match was
successful. I mention it mainly because it's a common error that is not
easy to detect at first glance :-)
The following test script does *not* demonstrate any issue, because
FindXml is called anew for every filename, while the script below uses the
match in a loop.
Sorry again,
Dani
Test script demonstrating the issue:
#!/usr/bin/perl
use strict;
use warnings;
my $pat='a';
for (qw/ a b c d/) {
(my $x=$_)=~/(^$pat$)/;
print Found $pat in /$_\n if $1;
}
__END__
# Output is:
Found a in a
Found a in b
Found a in c
Found a in d
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Seek wrap reformat routine
[EMAIL PROTECTED] am Freitag, 9. Februar 2007 14:11:
I just found this one online but not sure I understand it
what are the .{ and s/ called so I can look them up?
http://user.it.uu.se/~matkin/programming/PERL/perl-cookbook.shtml
perl5 -p000e 'tr/ \t\n\r/ /;s/(.{50,72})\s/$1\n/g;$_.=\nx2'
perl -n00e'tr/\n/ /; print $1\n while s/^(.{0,69}\S)\s+//; print \n'
If you speak about this part: s/(.{50,72})\s/$1\n/g
.{50,72} belong together. {} is one of the possible quantifiers.
It means (in this case, without the /s modifier):
match any sequence of characters (except newline) of minimal
length 50 and maximal length 72
There are two 's/' combinations in the expample:
The first is part of the 's///' construct, meaning it's a substitution.
In the second, '\s' belong together (without the following '/').
'\s' means white space character.
You can read all about this by typing
perldoc perlre
on the command line
Hope this helps!
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Merging Two One Liners without Temp Files
[EMAIL PROTECTED] am Freitag, 9. Februar 2007 14:21:
How do I get these two into one one liner?
Obviously, semicolon, but I want to operate on the file
all over again without using tmp files.
[1]
cp /net/u/1/v/vjp2/weco.txt /net/u/1/v/vjp2/junk.tmp
[2]
cat /net/u/1/v/vjp2/junk.tmp | perl -n00e'tr/\t\r\n/ /; \
print $1\n while s/^(.{0,36}\S)\s+//; \
print \n' /net/u/1/v/vjp2/junk2.tmp
[3]
cat /net/u/1/v/vjp2/junk2.tmp | perl -pe 'if ($.%4==2) {$_ .= \
qq(\n).(q(-) x 37).qq(\n)} elsif ($.%4==0) \
{$_ .= qq(\n).(q(=) x 37).qq(\n)} else {$_ .= qq(\n)};'
The lines [2] and [3] contain the answer to your question: Intermediate files
can be replaced by using a pipe (|).
So, instead of writing to a file via redirection () in [1] and then catting
this file again in [2], use a pipe.
What's done in [1] seems superfluous to me; you can start with weco.txt
directly.
Personally, I don't think it's the best idea to start using perl by playing
perl golf...
Hope this helps
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: I get no command found
[EMAIL PROTECTED] am Donnerstag, 8. Februar 2007 17:09: When I run command line perl (Unix or DOS) something gives me errors (several times) as if perl is trying to send something to the shell command line. Alternatively, it expects further input and I hit either ^Z or ^D, but it doesn't do anything. Since this is happening both on DOS and Unix, it must be my mistake. For example perl -pe 'print goat \n ' (expects input here) Try without the -p switch and read about it in perldoc perlrun. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: how to embed data in perl programs
Sharan Basappa am Mittwoch, 7. Februar 2007 16:13: On 2/7/07, Rob Dixon [EMAIL PROTECTED] wrote: Sharan Basappa wrote: On 2/6/07, Tom Phoenix [EMAIL PROTECTED] wrote: On 2/6/07, Sharan Basappa [EMAIL PROTECTED] wrote: Question is how to embed text in a perl program instead of reading it from a file or initializing the text in a string variable. [snipped] while (MY_BLOCK) __MY_BLOCK__ It looks as if you've seen the special DATA filehandle and the __DATA__ marker; but those don't generalize like that. Nice try, though. (If you change those back to DATA in your program, I think it will do what you expected. Consider adding 'use strict' and 'use warnings', though.) What if I wanted to have multiple embedded (and separate) texts embedded in my program. [snipped] What the DATA filehandle does is to allow the Perl program to read from its own source file. The read position is set initially to the point after the end of the program marked by the __END__ tag (as a mnemonic the __DATA__ tag serves the same purpose). Since a program has only one source file there can be only one such magic filehandle. (As a point of interest, it's possible for a program to read its own source by issuing seek DATA, 0, 0 before reading from the handle.) It's clearly possible to add markers within the data so the the program can split it up itself, but how about explaining a little more about what you want to do: I'm sure the list can come up with an appropriate solution for you. What is wrong, for instance, with using real separate data files? Actually I am writing a script that actually spits out various make template files. People then fill in these templates with neccessary details and use them. The thing is that there are atleast 4-5 different templates and depending on the cmd line arg, the script needs to output one of these template files. Definitely I would not like to open a file, read it and then output it since moving the script (to another project etc) would mean that the files need to be moved too. Having this information in the same script would make it self contained. Does that make sense... Hello Sharan Another possibility to avoid reading external data that would have to be moved with the script could be (but this depends a bit from the details) to design a template base class and, for every template, a separate subclass. The script itself could be very short, and would load (use) the appropriate subclass determined by the argument(s). To add a new template, you would not have to edit an existent file, but just add a new subclass. No need to move the modules around for a new project on the same machine; and for new projects on another machine, you could pack the modules into a distribution and install it with a few make commands. When going this way, chances are that you don't have to deal with redundant data at different places in case of changes/additions. From this point of view, a self contained script could be a disadvantage. This may be overkill; but if there's a possibility that the whole thing had to be expanded in the future, it's maybe not. Sorry for my english; I hope I did not miss an important point and my suggestions makes some sense. :-) Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: trouble with list context assignment for substitution inside File::Find wanted function
Michael Alipio am Mittwoch, 24. Januar 2007 04:21:
From: John W. Krahn [EMAIL PROTECTED]
Sent: Wednesday, January 24, 2007 10:57:51 AM
Yes, the substitution operator (s///) returns true (1) or false ('') in
either list or scalar context. To do want you want you have to do the
assignment first and then do the substitution:
my $newname = $_;
$newname =~ s/^\w+-//;
Or in one statement:
( my $newname = $_ ) =~ s/^\w+-//;
I've already figured that one out. However, I want to use variables for my
regexp pattern. So I can replace axis with whatever I my first program
argument is.
[...]
Hi Michael
find (\renamefiles, './');
my $name = shift;
You initialize $name after the call to find(), so renamefiles() has nothing in
$name. Switch these lines (and test the user provided contents of $name)
sub renamefiles{
if ($_ =~ /$name/){
if ($_ =~ /\Q$name\E/){
just in case $name contains chars that are special to the regex engine.
my $oldname = $_;
$_ =~ s/\w+-//;
#rename ($oldname, $_)
print $oldname will be renamed to $_\n;
}
}
I got many of this:
Use of uninitialized value in regexp compilation at test.pl line 11.
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: putting ; as a replacement in the substitution.
Michael Alipio am Sonntag, 21. Januar 2007 04:08: Hi, Hi Michael my $string = 'vd=root,status='; #Now, I want to transform it into: 'vd=root;status=' #That is replace the comma(,) between root and status with semicolon (;); $string =~ s/vd=\w+(,)/;/; print $string,\n; #And it prints: ;status= Can you tell me why it has ate up vd= as well? Because everything matched - that is: vd=\w+(,) - is replaced with the semicolon. You seem to misunderstand the meaning of the capturing parenthesis '()' on the left part of the substitution: They do not indicate the part of the string that is to be replaced; replaced is what the left side of the substitution matches. And how to get around with it.. One way is: $string =~ s/(vd=\w+),/$1;/; There are several man pages, where also the capturing parenthesis and the $1.. $n variables are explained: perldoc perlre perldoc perlretut perldoc perlrequick Hope this helps! Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: maximum file size for while(FILE) loop?
David Moreno Garza am Sonntag, 21. Januar 2007 07:50:
On Sat, 2007-01-20 at 09:31 +1100, Ken Foskey wrote:
What's exactly the difference between:
++$lines and $lines++; ?
Nothing in this context.
What about other contexts?
Hi David
#!/usr/bin/perl
use strict;
use warnings;
{ # preincrement
my (%h, $i);
$h{++$i}='hi';
print keys %h, , $i\n;
}
{ # postincrement
my (%h, $i);
$h{$i++}='hi';
print keys %h, , $i\n;
}
__END__
1, 1
0, 1
The difference is the order of read current value (used as hash key value)
and increment current value (done by ++ operator).
There's no difference between standalone ++$lines and $lines++ because only
increment takes place, and the result value is not used in the same
expression.
See also perldoc perlop, Auto-increment and Auto-decrement.
Hope this helps!
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: putting ; as a replacement in the substitution.
Michael Alipio am Sonntag, 21. Januar 2007 13:07: D. Bolliger [EMAIL PROTECTED] Because everything matched - that is: vd=\w+(,) - is replaced with the semicolon. You seem to misunderstand the meaning of the capturing parenthesis '()' on the left part of the substitution: They do not indicate the part of the string that is to be replaced; replaced is what the left side of the substitution matches. I see... so in substitutions, all patterns in the left side are those that have to be substituted, regardless of which is enclosed in parenthesis. Yes (and the whole left side constitutes *the* search pattern). However in a plain regexp look ups, only those inside the parenthesis are being matched... [snipped] No, only those inside the parenthesis are being *catched* into the $1..$n variables. For the catching taking place, the *whole* regex must match, and what's catched is/are part(s) of what matched. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: Hello and a question
Dr.Ruud am Donnerstag, 4. Januar 2007 19:37: D. Bolliger schreef: perldoc -f cp You were kidding, right? :) ugh, my mail client must have automatically abbreviated perldoc File::Copy # inlcuding cp :-) thanks, Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: ***SPAM*** Hello and a question
Tom Messmer am Mittwoch, 3. Januar 2007 17:02: Hello everyone, Hello Tom Just joined this list and I have a doozie I've been working on for a bit here to no avail. The entire problem is this; I have a list of files, say that they are named flynn.foo, flynn_something.foo, flaherty.foo flaherty_something.foo and so forth. Each of these files must live(be moved to) an individual directory named for the author(flynn, flaherty, etc) and then be symlinked to an entirely different directory in another part of the filesystem identical to the first one(flynn, flaherty...) If I was doing this on the command line I'd do cp /usr/blah/flaherty.foo /usr/blah/blahagain/flaherty/ ln -s /usr/blah/blahagain/flaherty/flaherty.foo /usr/blah/ blahoncemore/flaherty.foo Can you post what you have so far? So far I've gotten to the point where I can strip out the names from the files and create the two sets of directories, but I'm stumped on how to them copy each of these files into the correct directory perldoc -f cp and then symlink from the storage directory to the other name directory. perldoc -f symlink Now I know how to copy files and symlink files with perl, but the logic involved in doing this to 30 files is beyond me at the moment. Anyone have a clue? perldoc -f foreach Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: Syswrite Function in Perl
D. Bolliger am Dienstag, 2. Januar 2007 12:55:
Dharshana Eswaran am Dienstag, 2. Januar 2007 08:02:
[snip]
$seq = STDIN;
chop($seq);
@seq = split(/ +/, $seq);
$seq_len = @seq;
[snip]
for($i=0; $i$seq_len; $i++) {
$read1[$i] = $table{$structure{$seq[$j]}};
syswrite (OUT, $new, $read1[$i]);
print OUT (\n);
$j++;
}
In the above code, i m trying to read the input in bytes and display them
in another output file. The reading is done in different sizes (4 or 8 or
32bytes), as per the sequence specifed by the User. The input file with
filehandle IN contains data as shown below:
F1 2F 8A 02 05 09 00 00 00 04 2B 48 00 00 00 68
[snip]
Then you can inspect the values in $seq[$j] (with a warn statement), and
you'll see what's going wrong :-)
[snip]
Apologies to all :-( - and a happy new year :-)
John's answer pointed me to the fact that I did an error while trimming down
Dharshana Eswaran code; I put the IN file data into @seq, not the STDIN data.
How stupid of me.
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Syswrite Function in Perl
Dharshana Eswaran am Dienstag, 2. Januar 2007 08:02:
Hi All,
Hi Dharshana Eswaran
I have a piece of code which reads as shown below:
unless (open(IN, in.txt)) {
die(Cannot open input file \n);
}
binmode(IN);
unless (open(OUT, +output.txt)) {
die(Cannot open input file input.txt\n);
}
%structure = (1 = A, 2 = B, 3 = C,
);
@keys = keys %structure;
%table = (A = 4, B = 8, C = 32,
);
$j=0;
print(ENTER THE SEQUENCE between[1-3]:\n);
$seq = STDIN;
chop($seq);
@seq = split(/ +/, $seq);
$seq_len = @seq;
$input = IN;
@input = split(/ +/, $input);
$new = join (, @input);
for($i=0; $i$seq_len; $i++) {
$read1[$i] = $table{$structure{$seq[$j]}};
syswrite (OUT, $new, $read1[$i]);
print OUT (\n);
$j++;
}
In the above code, i m trying to read the input in bytes and display them
in another output file. The reading is done in different sizes (4 or 8 or
32bytes), as per the sequence specifed by the User. The input file with
filehandle IN contains data as shown below:
F1 2F 8A 02 05 09 00 00 00 04 2B 48 00 00 00 68
When i use syswrite function, i face the following problem
syswrite (OUT, $new, 4); = Writes 4 bytes properly
syswrite (OUT, $new, $val); (where $val =4;) = Writes 4 bytes properly
syswrite (OUT, $new, $read1[$i]); = This does not work. It displays all
the bytes together, without seperators(new line). I dont know the reason.
Can anyone please guide me in this?
My tip is that you start your code (always) with the two lines
use strict;
use warnings;
and define all your variables. You will get warnings like this for the line
above the syswrite line:
Use of uninitialized value in hash element at XXX line YYY.
Then you can inspect the values in $seq[$j] (with a warn statement), and
you'll see what's going wrong :-)
There are also missing checks for open, close, and syswrite; the second die
statement is misleading; most double quotes can be replaced by single quotes
because nothing is interpolated into the strings; some constructs can be
simplified and expressed in a shorter way; some statements are old style
perl.
How about modifying the code and reposting it when it does what you want?
Happy new year
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: DBI::execute(): how to evade quoting identifier names
Bram Kuijper am Dienstag, 2. Januar 2007 18:07: Hi all, Hello Bram Kuijper I try to execute the following SQL query in PostGreSQL 8.1. However, it gives errors since DBI::execute() automatically quotes when it inserts its arguments into the SQL query. Is there any way to change the quoting behavior of DBI::execute(): my $qry = ALTER TABLE mytable ALTER COLUMN ? TYPE double precision; my $qry_sth = $dbh-prepare($qry); $qry_sth-execute($col_name); which results in the following query being executed: ALTER TABLE mytable ALTER COLUMN 'column_name' TYPE double precision The inserted variable, which is an identifier, will receive single quotes by DBI::execute(). PostGreSQL gives an error, since it only accepts unquoted identifiers. How can I change DBI::prepare() or DBI::execute default behavior, so that added values go unquoted? I have the idea that this should be done by adding some statement handling attribute to the $qry_sth object, but the DBI documentation is not very explicit about it. It states: Placeholders and Bind Values With most drivers, placeholders can’t be used for any element of a statement that would prevent the database server from validating the statement and creating a query execution plan for it. For example: SELECT name, age FROM ? # wrong (will probably fail) SELECT name, ? FROM people# wrong (but may not ’fail’) I think since the alter table operation is not likely to be executed many times, and there's no execution plan to calculate, it's ok to simply: # sanitize $column_name here to prevent sql injection $dbh-do( ALTER TABLE mytable ALTER COLUMN $column_name TYPE double precision ) or die $dbh-errstr; # see the do() method in perldoc DBI Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: 'unknown column' error
Huub am Mittwoch, 20. Dezember 2006 14:47:
Hi,
Hello
I'm trying to insert a record in a MySQL database using Perl. I already
wrote a (working) Perl script to make queries, but now I get this problem.
This is the relevant part of the code:
$plaats = Oostvoorne;
$straat = Middellandweg;
$teller = 3;
$complex = 5;
$opdracht = insert into woningen (complex,plaats,straat,huisnr) values
($complex,$plaats,$straat,$teller);
warn $opdracht;
would show what is going wrong :-)
$sth = $dbh-prepare($opdracht);
$sth-execute or die Connection Error: $DBI::errstr\n;
This is the errormessage:
DBD::mysql::st execute failed: Unknown column 'Oostvoorne' in 'field
list' at /home/Huub/workspace/VulWoningen/VulWoningen.pl line 31.
Connection Error: Unknown column 'Oostvoorne' in 'field list'
It says 'Unknown column'. That is right: It's no column, it's data to be
inserted into the column. When I use the query directly in MySQL,
there's no problem. So what is going wrong here?
That's because the (string) values do not appear quoted in the insert
statement and thus are interpreted as field names;
the quotes in Oostvoorne are on the perl level.
You would have to write it like 'Oostvoorne' or better q('Oostvoorne').
The better way is imho to use the quote() method for values,
and the best to use ? placeholders and give the values to the execute()
method - which prevents sql injections on a basic level.
See perldoc DBI
Hope this helps!
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: File:: Copy
Jeff Pang am Mittwoch, 20. Dezember 2006 15:09: Dukelow, Don [EMAIL PROTECTED] I can't get use File::Copy to work. I declare it at the beginning of script but when I try to use it latter nothing happens. There are no errors and nothing is copied. Did you also add use strict and use warnings at the begin of the script and still saw nothing? ...and it would also be a good idea to check if the copy operation succeeded - see the the SYNOPSIS example in perldoc File::Copy :-) Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: finding corrupt files
Sharan Basappa am Montag, 18. Dezember 2006 08:09:
On 12/17/06, D. Bolliger [EMAIL PROTECTED] wrote:
Sharan Basappa am Sonntag, 17. Dezember 2006 16:22:
Hello
While going through some of the old text files, which til now I thought
were in good shape, found
that some of the files were corrupt and contained garbage data.
We need to know more; what garbage? Where in the file? Are the files
corrupt
because they were stored on for example old floppies?
I would
like to know if there is a
simple way to find this out using script since I have 100s of such
files and it is difficult for me to go through all these files ..
What's garbage and what's not depends from the format of the file
content, it's intended usage...
Your task may be easy or nearly impossible to solve automatically.
If there's a way to exactly separate garbage from non-garbage, and
express this with means of a script language, it may be easy.
Hello Sharan Basappa
(please don't top post)
actuall these look like invalid ascii files to me (files seem to look like
binary content).
typically this happens when I transfer files from one machine to another
using my usb key.
But this is not the case with all files. So this is the reason I wanted to
know if there is a way to
recursively go through all files and report if a file does not seem to a
valid ascii file ..
Maybe the following script [tested] can be a start, you'd have to adapt it to
your needs.
Dani
#!/usr/bin/perl
# usage: this_script filename1 [,filename2 ...]
use strict;
use warnings;
# ***Adjust to your needs***, see perldoc perlre
#
# (invalid defined as not in the set of valid chars
#
my $invalid=qr/[^0-9a-zA-Z_!?.;,\s'()-]/;
my @invalids=(); # contains filenames
for my $fn (@ARGV) {
open my $fh, '', $fn or die $!;
while ($fh) {
if (/($invalid)/) {
warn '$fn' seems to have a first invalid char '$1' on line $.\n;
push @invalids, $fn;
last;
}
}
close $fh or die $!;
}
warn \nfiles with invalid chars:\n, (join \n, @invalids), \n;
__END__
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: reg exp continued need pulled from reference
oryann9 am Montag, 18. Dezember 2006 16:55: Hello... I have thought about this one and tried various code changes but cannot get what I want. My problem: mismatched UIDs in password files. My solution: #1 store passwd files in a globbed array #2 create array reference from globbed array #3 open array ref, create hash with more than one value per key. Keys are regexps from filenames #4 read in every line of passwd files from reference. Values in hash need to be passwd entries For example: key = servernames.platform (dubhpr01.hpux) values = filelds from passwd file (name,uid,gid,comments) #5 Once hash is built, traverse through searching for usernames that have unlike UIDs from all files, then print these to an xls using SpreadSheet::WriteExcel. In my code I have completed 1,2 and 3. Started 4 but I am printing the array reference address as opposed to printing the actual values. What am I doing wrong and any tips would be nice? _OUTPUT_ KEY dubhst14.hpux ELEMENTS /home/dbsmith/passwd.dubhst14.hpux DUB VALUES root KEY dubhdv05.hpux ELEMENTS /home/dbsmith/passwd.dubhdv05.hpux DUB VALUES root dubhst14.hpux = ARRAY(0x4002b0f8) dubhdv05.hpux = ARRAY(0x4059c9a4) dubhadm3.hpux = ARRAY(0x4059c8f0) [snipped] #!/usr/bin/perl ##-- Initialize environment --## use strict; use warnings; use diagnostics; use Spreadsheet::WriteExcel; [snipped] print $dub_key = $dub_values\n; [snipped] Derek, I guess the reason why you got no answer when you posted the identical question in a recent thread is because, at least - your question(s) is/are unclear - your code is not trimmed - even not from comments Anyway. When you print $dub_values and it shows up as an array ref as ARRAY(0x4002c164) and you want the values of this arrayref, you have to dereference it in some way. Start with printing out @$dub_values. Or assign it before if you want bigger freedom to format the values: my @[EMAIL PROTECTED]; # handle @dub_values_arr Hope this helps Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: How do I tell perl -w: I really want to use this var just once
Kelly Jones am Dienstag, 19. Dezember 2006 01:49:
perl -w dings me if I use a variable just once:
Name main::foo used only once: possible typo...
even if I'm magically defining/using $foo somewhere else.
Is there any way to tag a variable to tell the -w option that I'm
intentionally using that variable just once, and not to warn me about it?
I realize I could do something like: $foo = $foo to force the issue,
but that seems kludgy.
Is it really not possible to
use warings;
use strict; # -- your friend!
my $foo=1; # -- declare lexical var with 'my'
print $foo; # prints 1
?
Then use
use warnings;
{
no warnings 'once';
$foo=1;
}
print $foo; # prints 1
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: reg exp continued need pulled from reference
oryann9 am Montag, 18. Dezember 2006 19:52: D. Bolliger [EMAIL PROTECTED] wrote: [snipped] How are my quesitons unclear??? [snipped] I answered offlist. Sorry to all for the noise of this notice. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: finding corrupt files
Sharan Basappa am Sonntag, 17. Dezember 2006 16:22: Hello While going through some of the old text files, which til now I thought were in good shape, found that some of the files were corrupt and contained garbage data. We need to know more; what garbage? Where in the file? Are the files corrupt because they were stored on for example old floppies? I would like to know if there is a simple way to find this out using script since I have 100s of such files and it is difficult for me to go through all these files .. What's garbage and what's not depends from the format of the file content, it's intended usage... Your task may be easy or nearly impossible to solve automatically. If there's a way to exactly separate garbage from non-garbage, and express this with means of a script language, it may be easy. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: $ARGV[0] breaks the script
Gregory Machin am Freitag, 15. Dezember 2006 14:05:
On 12/14/06, D. Bolliger [EMAIL PROTECTED] wrote:
Gregory Machin am Donnerstag, 14. Dezember 2006 13:24:
[reordered]
#!/usr/bin/perl
# if your prgram has the string grep in the name or in the path
# this program won't work.
use strict;
use warnings;
my $line;
my $input;
$input=$ARGV[0]; #$input=httpd;
chomp $input;
open PROS, ps -ef|grep $input |;
while ($line = PROS){
unless ($line =~ m/grep/){
print $input is running\n;
exit;
}
}
print $input isn't running\n;
exec /etc/init.d/$input restart ;
the script will not work
Not work? :-)
if I use $ARGV[0] but works 100% if I hard
code the $input variable;
what have i missed ?
You can give anything as cmd line argument, and the script will tell you
that it is not running, because of
a) open PROS, ps -ef|grep $input |;
combined with
b) unless ($line =~ m/grep/){...}
This script is running as root... that makes it even more important to
check user provided data, what exactly is executed in the shell, and what
binaries are called.
- use absolute paths for binaries (ps and grep in this case)
- make sure that $input only contains ascii characters
for example, in this case, only a to z:
my ($input) = $ARGV[0]=~/([a-z]{,16})/; # untested
die unless $input;
btw: /etc/init.d/grep start ???
This is a hint to also check if $input corresponds to a binary
in /etc/init.d at the beginning of the script :-)
This would solve the grep-not-allowed/script-uses-grep-and-does-not-work
problem :-)
What about also using /etc/init.d/some_daemon status and check if this
information is in sync with the ps output (it isn't always, and the
restart could therefore fail - what you don't test)
Hi thanks for looking at the script..
Just to clarify, the scipt runs perfectly if $input it hardcoded eg
$input=httpd.
thus if the process is running then it exits, if the process is not
running then it exicutes
exec /etc/init.d/$input restart ;
Hm, possibly I overlooked something, misinterpreted my tests (with modified
code), and guessed wrong. At the moment I have no time to look further at it,
so just a small tip:
But if I use $input=$ARGV[0] to give the process name from the command
line, it runs as if the process is running if if I have stoped/killed
it..
the only reason for this is that there is a hidden character, but
where is it comming from ?
What hidden character is it? I think it's not a line end character \r, \n,
^M... (you chomp())
What results when you print out $input and the cmdline to be executed like
this, to see the string between '' and '':
warn $whatever_to_print; ?
Dani
P.S.: Please post inline :-)
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Modify several files in a directory....
Brad Grandorff am Donnerstag, 14. Dezember 2006 03:02:
D. Bolliger [EMAIL PROTECTED] wrote: Brad Grandorff am Donnerstag, 14.
Dezember 2006 01:58:
I have managed to get a one liner working for modifying a particular
file in a directory, and I have also used arrays to read in then modify
a particular file... but I can't seem to do so using opendir and
reading in several files at once...
Could you post your one liner?
Basically I want to search several files within a directory for a
particular keyword, then replace that keyword with a user provided
value..
I know it is pretty straightforward and simple...
Does anyone have any example scripts / code that I can look at?
Did you look at File::Find?
...functions for searching through directory trees doing work on each
file found similar to the Unix find command.
You could use code from your one liner and modify it for usage in the
wanted callback.
Yes I did actually... but I haven't been able to put it all together yet.
I had originally tried variations of the following..from some example
code..but it was wiping out the contents of the file when writing.
Hello Brad
(please answer to the list)
#!/usr/bin/perl
use File::Find;
$path = /downloads;
find (\edits, $path);
sub edits(){
$seen = 0;
if (-f and /.html?/){
# $_ only contains the basename, so the -f test may not test the file you want
# Also, you want to test the file _end_, so you have to anchor the pattern;
# '.' in a regex means any character - you want a literal '.'
# See perldoc perlre
$file = $_;
# replaced by the assignement above
open FILE, $file;
# Always check if open succeeded
@lines =FILE;
# If you don't have a specific reason to proceed linewise, you could
# slurp the content in a single string, by setting $/ to undef beforehand
# [ local $/; ] (but you seem to have that reason)
close FILE;
for $line (@lines) {
if ( $line =~ s/Lesson/Chapter/ ) {
if ($line =~ s/width/ ) {
# These patterns may not be enough specific, if they should denote words
# and not also word parts.
# The second is a match, not a replacement :-)
$seen++;
}
}
open FILE, $file;
print @lines;
# This will print to the default file handle, STDOUT, not top FILE;
# and, you write the file for every processed line!
close FILE;
}
}
print Found in $File::Find::name\n if $seen 0;
}
My one liner I lost...but bascially it simply looked for the following
regex and replaced it with the user defined variable...:
=~ s/\/sm\/logo.gif/\/sm\/$logo/g;
s|/sm/logo\.gif|/sm/$logo/g; # \/ :-) \/
Ok, here is a version with the modifications mentioned above and some small
others [tested, but afterwards slightly changed]:
#!/usr/bin/perl
use strict; # !!
use warnings; # !!
use File::Find;
my $path = '/downloads';
find (\edits, $path);
sub edits(){
my $fn=$File::Find::name;
if (-f $fn and /\.html?\Z/){
my $seen = 0;
open my $file, '', $fn or die $!;
my @lines =$file;
close $file or die $!;
my $modified=0;
for (@lines) {
if ( s/Lesson/Chapter/ ) {
$modified++;
$seen++ if /width/;
}
}
if ($modified) {
open $file, '', $fn or die $!;
print $file @lines;
close $file or die $!;
}
print '$fn': modifications=$modified, seen=$seen times\n;
}
}
__END__
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: $ARGV[0] breaks the script
Gregory Machin am Donnerstag, 14. Dezember 2006 13:24:
hi
Hi Gregory
the script will not work
Not work? :-)
if I use $ARGV[0] but works 100% if I hard
code the $input variable;
what have i missed ?
You can give anything as cmd line argument, and the script will tell you that
it is not running, because of
a) open PROS, ps -ef|grep $input |;
combined with
b) unless ($line =~ m/grep/){...}
This script is running as root... that makes it even more important to check
user provided data, what exactly is executed in the shell, and what binaries
are called.
- use absolute paths for binaries (ps and grep in this case)
- make sure that $input only contains ascii characters
for example, in this case, only a to z:
my ($input) = $ARGV[0]=~/([a-z]{,16})/; # untested
die unless $input;
btw: /etc/init.d/grep start ???
This is a hint to also check if $input corresponds to a binary
in /etc/init.d at the beginning of the script :-)
This would solve the grep-not-allowed/script-uses-grep-and-does-not-work
problem :-)
What about also using /etc/init.d/some_daemon status and check if this
information is in sync with the ps output (it isn't always, and the restart
could therefore fail - what you don't test)
hope this helps
Dani
#!/usr/bin/perl
# if your prgram has the string grep in the name or in the path
# this program won't work.
use strict;
use warnings;
my $line;
my $input;
$input=$ARGV[0]; #$input=httpd;
chomp $input;
open PROS, ps -ef|grep $input |;
while ($line = PROS){
unless ($line =~ m/grep/){
print $input is running\n;
exit;
}
}
print $input isn't running\n;
exec /etc/init.d/$input restart ;
Many thanks
--
Gregory Machin
[EMAIL PROTECTED]
www.linuxpro.co.za
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Yet another parsing question
Gallagher, Tim F (NE) am Donnerstag, 14. Dezember 2006 15:29: Lets say that I have a list of data that have a few things in common, ie this is a 1 test to see 2 what is happening 3 to the state of the 4 country all work 1 and no 2 play makes 3 jack a dull boy 4 how 1 much wood 2 could a wood 3 chuck 4 chuck so I want to grab all data between 1 - 2 and 3 - 4 2 different variables, can this be done? Yes :-) Use capturing parenthesis for that, see perldoc perlre Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
[OT?] Re: Which module for web graph?
Chad Perrin am Donnerstag, 14. Dezember 2006 19:36: On Thu, Dec 14, 2006 at 10:53:26AM -, Dermot Paikkos wrote: On 14 Dec 2006 at 5:44, Jeff Pang wrote: Sorry that I never drew the graph for HTML page.Now I need to generate some histogram for the statistic datas,I searched CPAN and found lots of modules can be used. Can you help give the suggestion that which is better (or easy) for my purpose? Thanks. Yes GD (and GD::Graph) are the most used but, personally, I find that the produce charts that look a bit clunchy. You could also try SWF::Chart. This is an interface to SWF Chart (macromedia flash) and the appearance of these graphs is a bit more pleasing on the eye. That's great, as long as you don't mind accessibility issues and excluding all potential visitors to your site who don't use a Flash plugin for their browsers. For instance, me. Here's an even worser example I tried to visit today: it's completely unaccessible without flash: http://www.limmatdruck.ch (translation of the box: Either you have not installed a flash plugin or a version below 6. To be able to navigate this site, please install the newest version of the flash player) You know, my son, in the old days, you could even find *text* on the internet! Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: creepy print() that doesnt print.
Gregory Machin am Mittwoch, 13. Dezember 2006 12:08:
Hi
Hello Gregory
please could you have a look and see what I have missed.
use strict;
use warnings;
# and declare variables with 'my' where missed
use File::Tail;
my $name=/etc/openvpn/logs/CT-NET.log;
my $name='/etc/openvpn/logs/CT-NET.log';
my $maxinterval=10 ;
my $adjustafter=7 ;
$file=File::Tail-new(name=$name, maxinterval=$maxinterval,
adjustafter=$adjustafter);
while (defined($line=$file-read)) {
print ($line);this line prints fine
print $line;
print (hello); but this one does not print at all
}
i have allso tried print hello; but the result is the same..
I have tried ping ($line hello); but it does not print the hello.
what have I missed ..
This is an buffering issue; normally, the output buffer is only flushed if it
contains enough data (to fill the entire buffer), after a line end is printed
to the buffer, or if the program ends (then buffers are flushed before file
handles are closed).
This has nothing to do with File::Tail; the following code will also not
print 'hello' (until it ends after 10 seconds):
print 'hello';
sleep 10;
What you can do:
1. append a \n to hello:
print (hello\n);
2. setting the $| variable to a true value, for example with:
{
local $|=1;
print ('hello'); # original line; note single quotes
}
See perldoc perlvar for the $| variable
Hope this helps!
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Modify several files in a directory....
Brad Grandorff am Donnerstag, 14. Dezember 2006 01:58: I have managed to get a one liner working for modifying a particular file in a directory, and I have also used arrays to read in then modify a particular file... but I can't seem to do so using opendir and reading in several files at once... Could you post your one liner? Basically I want to search several files within a directory for a particular keyword, then replace that keyword with a user provided value.. I know it is pretty straightforward and simple... Does anyone have any example scripts / code that I can look at? Did you look at File::Find? ...functions for searching through directory trees doing work on each file found similar to the Unix find command. You could use code from your one liner and modify it for usage in the wanted callback. Hope this helps Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: module to calculate time difference between two
kilaru rajeev am Dienstag, 12. Dezember 2006 13:22: Hi All, Hello I want to calculate the time difference(hh:mm:ss) between two when they are provided with date and time. Could anyone provide the module to handle this? There are different modules to handle date/time tasks. CPAN is a great help. You can search by keywords, check the manuals, look at the source - all this without installing anything: http://search.cpan.org Also check the archives of this mailinglist, and google, on how to use either of these possibilities. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: reg exp
Derek B. Smith am Dienstag, 12. Dezember 2006 23:19: I have a string like so: /home/dbsmith/passwd.oftappp1.hpux and I need to parse out oftappp1 and hpux. I have tried to use substr and and regexp with =~. Here is what I have tried, but need some help cause I am getting frustrated. NOTE: strings after passwd are variable in length, could be 3-10 characters long. use strict; use warnings; my $string = qw(/home/dbsmith/passwd.dubhpr01.sun); #my ($host_name) = $string =~ /\.\w+\.\w+/g; [snipped] my ($offtap1, $hpux)='/home/dbsmith/passwd.dubhpr01.sun'=~/\.(\w+)\.(\w+)\Z/; More general help for all sorts of regex tasks is provided by perldoc perlre. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: extracting common substrings...
Helliwell, Kim am Dienstag, 12. Dezember 2006 21:56:
Is there a function (perhaps in a library module) that would take two
strings and return the common substring (if any) contained in the
arguments? I've been looking for such a beast on CPAN, but no luck so
far.
If not, I guess I have to write it myself...
While I was writing it myself ;-) because I did not find anything via google
or CPAN - missing term LCSS... John posted Algorithm:LCCS.
I thought I post it anyway instead of copying it to /dev/null.
The script contains a testcase with long strings, it takes 1.2 secs on my
old machine (the test case is certainly not a worst case scenario).
It is just a dirty hack, using a naive aproach, and not proved to work
correctly.
Here it is, comments are welcome:
#!/usr/bin/perl
use strict;
use warnings;
sub lcss {
my ($s1, $s2)[EMAIL PROTECTED];
my $max1=length($s1)-1;
my $max2=length($s2)-1;
# make $s1 the shorter string
#
($s1, $s2, $max1, $max2)=($s2, $s1, $max2, $max1)
if $max1 $max2;
my %found;
my $longest=0;
foreach my $i (0..$max1) {
foreach my $j ($i..$max1) {
my $searchlen=$j-$i+1;
next if $searchlen $longest; # because longest css searched
my $search=substr($s1, $i, $searchlen); # pattern to search
$found{$1}++ for ($s2=~/($search)/g); # although count not used below
# not optimal because no test if match succeeded above
#
$longest=$searchlen if defined $1;
}
}
# (should) select only one random longest string if several present:
#
print '(one) LCSS found: ',
(sort {length($b) = length($a)} keys %found)[0], \n;
}
### Test case:
my $pat=join '', 'hello' x 100;
my $bar=join '', 'hello' x 99;
my $foo=join '', 'a' x 100;
lcss ($pat, $bar.$foo.$bar.$pat.$bar.$foo.$bar);
lcss ('donut', 'I just want to eat one donut please!');
lcss ('I just want to eat one donut please!', 'donut');
__END__
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: extracting common substrings...
Tom Phoenix am Mittwoch, 13. Dezember 2006 02:32:
On 12/12/06, D. Bolliger [EMAIL PROTECTED] wrote:
$found{$1}++ for ($s2=~/($search)/g); # although count not used
below
Didn't $search just come from the data? It's a string, not a pattern.
If it's got any metacharacters, it could break your pattern, or worse.
Ouch, you're right Tom! I completely omitted (speak: forgot) *any* security
considerations at this development state :-(
= $s2=~/(\Q$search\E)/g
Waiting for other comments... good night, sleep time here :-)
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: extracting common substrings...
D. Bolliger am Mittwoch, 13. Dezember 2006 02:25: Sorry for answering my own post... [snipped] The script contains a testcase with long strings, it takes 1.2 secs on my old machine (the test case is certainly not a worst case scenario). [snipped] ### Test case: my $pat=join '', 'hello' x 100; my $bar=join '', 'hello' x 99; my $foo=join '', 'a' x 100; [snipped] With the following worser case test, my $baz=join '', 'hiho' x1; my $pat=join '', $baz, 'hello' x 100; my $bar=join '', $baz, 'hello' x 99; my $foo=join '', 'a' x 100; execution time increases to... wait a sec ;-)... still running... If there's a module, use the module ? Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Checking for infinite loops
hOURS am Donnerstag, 7. Dezember 2006 06:51: Thanks for trying, but this right here is the heart of the matter. Id be using alarm to time a certain thing. It seems to me, any explanation of how to do that, be it plain English or sample code has to incorporate that thing. My program in a nutshell goes: Blah blah blah the beginning part require someprogramthatmayhaveaninfiniteloop.pl Blah blah blah the ending part Note thats not the literal code. :) As it stands if someprogramthatmayhaveaninfiniteloop.pl does go on forever I will never get to the ending part. How would one add alarm to this such that the ending part gets executed regardless? Fred Kittelmann Where is the thing being timed? I understand something is being given 5 seconds, but what? Hello Fred I doubt that I understand what you exactly want (get your code working? Know how alarm works in detail?). Maybe somebody else does. If not, could you provide a trimmed down version of your program (the main program and the required someprogramthatmayhaveaninfiniteloop.pl) that can be run and modified. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Checking for infinite loops
hOURS am Sonntag, 3. Dezember 2006 03:25:
D. Bolliger [EMAIL PROTECTED] wrote: hOURS am Donnerstag, 30. November
2006 21:09:
Jen Spinney wrote: On 11/20/06, hOURS wrote:
Recently I posed a question on here regarding a program I have that
runs other programs (through require statements and what not). My
problem was that the programs getting run might have syntax errors and
I wanted to skip over each of those and go onto the next one. We
figured out a way to handle that. It turns out however, that these
programs sometimes have an even more troublesome problem: infinite
loops. I knew about this possibility, but figured I would just use the
time function, and if a program was taking to long, skip over it. Yeah,
that wasn't so smart. I can't have the main program check the elapsed
time while the required program is running its infinite loop. Or can I
somehow? Any ideas anybody? Thank you.
Fred Kittelmann
Fred,
Have you checked out the alarm function? I'm a beginner myself and I
had a similar problem earlier today. alarm seemed to do it for me.
Good luck!
- Jen
Thanks Jen,
I've checked out alarm as much as I can. My PERL textbook scarcely
mentions it. Trying perldoc -f alarm was a little more informative,
but I still don't understand how to use this. Can anyone explain it to
me? Fred
Does the following modified code example from 'perldoc -f alarm' helps?
Dani
#!/usr/bin/perl
use strict;
use warnings;
my $timeout=5; # secs
eval {
# Assign a signal handler subroutine which is invoked in case
# the alarm signal is sent
#
local $SIG{ALRM} = sub { die alarm\n }; # NB: \n required
# send an alarm signal after $timeout seconds!
#
alarm $timeout;
# to test a non-timeout die, uncomment following line:
#die;
# the problem:
#
endless_loop();
# reset alarm timer: Don't send alarm signal any more
#
alarm 0;
};
# Check if the code within eval died because of an alarm signal
# or something else. We check the die message for that.
#
if ($@) {
if ($@ eq alarm\n) {
warn endless_loop() interrupted after timeout\n;
}
else {
warn code in eval died!\n;
die;
}
}
warn program continues...\n;
sub endless_loop { {} while 1 }
__END__
Thanks, I suppose I understand that code example from 'perldoc -f alarm' a
little better. But much of it remains mysterious. e.g. the very first
thing within eval. The only brackets I've ever seen with variables are []
for list elements. What's going on with {}?
eval{} - see perldoc -f eval, it's the eval BLOCK variant.
$SIG{ALRM} - that's the way to retrieve the value with the 'ALRM' key from the
hash %SIG; analogous to retrieve the $i'th value $array[$i] from an array
@array. See perldoc perldata for the perl data types.
NB: The '$' indicates the data type of the *accessed* data ($SIG{ALRM},
$array[$i]), and '[]' versus '{}' shows you if the aggregated data
structure from which you take an element is a hash or an array.
There's another usage of {}:
my $x=1;
{ # make a scope block
my $y=2;
}
# $y is no more defined outside the scope block above.
And what a strange thing to
set a variable to - seems to be neither string nor number, but a
subroutine?
You refer to the line
local $SIG{ALRM} = sub { die alarm\n };
?
Assigned is a so called anonymous subroutine.
Above line could be reformulated by
sub alarm_sburoutine { die alarm\n };
local $SIG{ALRM} = \alarm_subroutine;
But since the subroutine is only used once and is very short, the original
line is an abbreviation.
see perldoc perlsub
And why would you have a subroutine with just one line?
Why not?
sub a_sub_returning_one { 1 };
print 'the sub returns ', a_sub_returning_one;
Of course you could write it like
sub {
die alarm\n;
}
White space in the program code does not matter in *most* cases, unless in
python for example.
And
how can you have a subroutine without a name?
See above, anonymous subroutine :-)
And without a call to it?
It *is* called at the time the alarm timer reaches 0, although not explicitly
from the code;
See perldoc perlipc; it explains signals handlers at the top.
Where is the thing being timed? I understand something is being given 5
seconds, but what? Why is the variable $SIG{ALRM} not used again?
Hm... somebody else may explain this much better than I;
alarm() is a form of IPC, using signals, and it is provided by the operating
system. perls alarm() is just an interface to the operating systems alarm
function. On *nix, see
man alarm
man signal
So it's timed in the OS, given 5 secs, and the subroutine (signal handler
in this context) is called from the OS internally.
Is
there some significance to the name of that variable?
yes, %SIG is one of the special variables of perl, see the following document
where all of them are described:
perldoc perlvar
Re: Sorting from subroutine call
Sergio Escalada am Samstag, 2. Dezember 2006 15:41:
Thanks for replies.
The purpouse of this mini-script is to list the rows from a database loaded
in memory ($ref_db is the reference to hashtable that cotains the DB). So I
want to order the fields by different sort rules, and make the proccess as
abstract as it's possible with a subrutine (sub cmpRule). This sub must
recieve the rules (by array argument, for example), and create the body
that will be called by sort.
You don't specify the exact requirements or data structures;
one way to do it in an abstract way is presented below.
I wrote this script from scratch; it *seems* to do what it should.
The idea is as follows:
1. According to perldoc -f sort, it's possible to give a code block
(delivering a subroutine reference) as argument to sort that does the
actual sort.
2. We don't code these different possible sorting subroutines explicitly,
since their number may be high (sort by one ore more fields, in
different order, ascending/descending, numeric/string sort
- in different combinations.
Instead, we code an abstract subroutine (sort_sub_factory)
that returns sorting subroutines created according to some rules.
The rules can be formulated in an easy way.
3. Every sorting routine craeated assumes the following data structure
of the db data (compare with the test data in the script):
$ref_db is a reference to an array (each array represents a database
record). The elements of the array contain hashrefs with
(fieldname, fieldvalue) pairs.
You can say for example: Sort first by field2 (ascending, numerical sort),
then by field1 (descending, string sort).
All combinations are possible.
You express above rules by
my @rules=( ['field2', 0, 0], ['field1, 1, 1] );
I hope this helps :-)
Dani
This is what I've done since I wrote the message (now, it only works with
one rule, but I think it's easy to do multiple-rules sort from here)
The comparation subroutine:
sub cmpRule
{
return '$$ref_db{$a}{$$ref_fields{$opt}[0]}'.
' cmp $$ref_db{$b}{$$ref_fields{$opt}[0]}';
}
...#some code
my $func = cmpRule;
foreach my $row (sort {eval($func)}keys %{$ref_db}){
...#some code
}
It works but, do you think it's a good solution?
Thanks for your time.
Sergio.
#!/usr/bin/perl
### THIS IS BETA SOFTWARE ###
use strict;
use warnings;
# @rules is a list of arrayrefs. Each array element contains the
# informations for one db field:
#
# [fieldname, desc_sort_bool, string_sort_bool].
# - sort descending if desc_sort_bool is true
# (else ascending)
# - sort via string comparison if string_sort_bool is true
# (else numerically)
#
# If @rules contains more than one element, the sorting is nested.
#
# ***BEWARE***: Sanitize all arguments before using in this sub!
#
sub sort_sub_factory {
my @[EMAIL PROTECTED];
my @sub_code_parts;
foreach my $rule (@rules) {
my ($field, $desc, $string)[EMAIL PROTECTED];
# handle boolean sort options
#
my $comp_op=$string ? 'cmp' : '=';
my ($a_var, $b_var)=$desc ? (qw/$b $a/) : (qw/$a $b/);
# create subroutine code parts
#
push @sub_code_parts,
'('.$a_var.'-{'.$field.} $comp_op .$b_var.'-{'.$field.})\n;
}
# put all parts together, producing source code for sorting subroutine
#
my $sub_code=
sub {
return
@{[join ' || ', @sub_code_parts]}
};
# just for debugging, output created source code:
#
warn \n\n\nGenerated code:\n, $sub_code, \n;
return eval $sub_code;
}
###
### TEST of above code
###
# helper sub to display sorted data
#
sub debug_print {
my ($title, $sorted_ref_db)[EMAIL PROTECTED];
print $title:\n;
foreach my $record_hr (@$sorted_ref_db) {
print join ', ',
map {$_ = $record_hr-{$_}}
sort keys %$record_hr;
print \n;
}
}
# our test data
#
my $ref_db=[
{f1='x', f2=2, f3='Q'},
{f1='x', f2=1, f3='A'},
{f1='x', f2=2, f3='A'},
{f1='x', f2=1, f3='Q'},
{f1='b', f2=2, f3='Q'},
{f1='a', f2=10,f3='A'},
{f1='a', f2=40,f3='C'},
{f1='x', f2=1, f3='X'},
];
# Several test sortings:
#
my ($title, $sort_sub);
$title ='by (f1, ascending, string comparison)';
$sort_sub=sort_sub_factory(['f1', 0, 1]);
debug_print ($title, [sort $sort_sub @$ref_db]);
$title ='by (f1, ascending, string comparison)' .
'(f2, ascending, numeric comparison)';
$sort_sub=sort_sub_factory(['f1', 0, 1], ['f2', 0, 0]);
debug_print ($title, [sort $sort_sub @$ref_db]);
$title ='by (f3, ascending, string comparison)' .
'(f2, descending, numeric comparison)';
$sort_sub=sort_sub_factory(['f3', 0, 1], ['f2', 1, 0]);
debug_print ($title, [sort $sort_sub @$ref_db]);
$title ='1st invalid request';
$sort_sub=sort_sub_factory(['f3', 1, 0]);
debug_print ($title, [sort $sort_sub @$ref_db]);
$title ='2nd invalid request';
{
local $SIG{__WARN__}=sub {print @_; die INVALID sort sub '$title'!};
[OT] Re: Net::EasyTCP
Derek B. Smith am Samstag, 2. Dezember 2006 17:08: --- zentara [EMAIL PROTECTED] wrote: On Fri, 1 Dec 2006 20:31:11 -0800 (PST), [EMAIL PROTECTED] (Derek B. Smith) wrote: I was hoping for socket data transfers to mimic an sftp/ftp get without having to deploy code to the clients and or deploying this module on the clients. Think about it, how could that work? You need some sort of code on the clients, whether it's your custom script, or existing server code. Do the clients run a web server? You could place the files in a htaccess password protected directory, and get them thru https? There are many ways to go, http, ftp, ssh2, etc. You don't have to install the Net::EasyTCP module on the clients. There is no xs component, it's pure perl. So you could actually include the EasyTCP code, as a package right into your script. zentara Hello Derek (and I hope it's ok for you zentara when I answer [too]) ok thanks 4 the advise, but I have thought about it. All the clients do not have the same access routes. For example, some have ssh turned on while others do not. Is it possible that you mean sshd (ssh *server*) by ssh turned on? Those that do not, have ftp and the majority of all the clients do not allow root login over ssh. Do they, on the other side, have installed an ssh *client*? So now u see my dilemma... I have begun to use an scp script, but I knew there was a way to use sockets to xfer files so I thought I would learn something new while I was getting all the files together. As far as I could follow this thread, you have to install something *anyway* on some (or even all - Net::EasyTCP) client boxes. I dont understand there is no xs component and I dont understand So you could actually include the EasyTCP code, as a package right into your script. I think zentara meant that it's sufficient to 'copy over' perl script/modules not involving compiling/installing/using software parts based on C. Some perl modules implement their functionality in C. The glue between perl and the C code is called 'XS' (hm, more or less at least). Have a look at XML::LibXML for example, that uses the libxml2 library. === My advice to you is to present your requirements to the secureshell and/or a security ML, and not yet thinking about which perl module to use. Assume that a box does not allow remote logins (could be, according to your descriptions). Now you want to bypass these restrictions only to transfer a file? I doubt this being a good idea. A more secure plan (in my eyes not belonging to a security guru) could be to let the clients initiate the file transfer. You'd have to run an sshd server on your main box. There are several possibilities to customize and secure ssh(d). Referring to another answer to one of my posts: Did you consider permissions of parent directories, the presence of a sniffer in your multifirewalled network, and other worst case scenarios? Did you analyse the risks involved throughly? These are all important non-perl-related questions that have earnestly to be taken into accound before anything else. Please somebody correct me if I'm wrong. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Complex regex help
Omega -1911 am Freitag, 1. Dezember 2006 06:05:
Hello all,
I am trying to parse calendar events for a rss feed into variables. Can
someone help with building the following regex or point me in the direction
of some good examples? Thanks in advance.
Here is what I have tried: (I don't know much about complex regex's as you
see)
$mystring =~ /.+(plib)(\w+) (FONT COLOR=\\#99\)(\w+)(\[Ref
\#(\d+\])(.+)$/);
Here is a sample string:
plib DATE FONT COLOR=#99TITLE/FONT/b EVENT a href=
http://www.mysite.comtarget=_new;www.mysite.com/a [Ref #67579]/li
What I would like to pull out is the TITLE EVENT information. The sample
string is the format for each event. Any takers on this? Again, thanks for
any help.
If you *really* want do it with a regex, and not a parser (XML::LibXML,
XML::Simple, etc.), here is one possibility.
However, note that a regex is very fragile if it comes to format changes, or
the input has unexpected chars in it. In the regex below, I try to be
flexible concerning white space in the input; one could also be more specific
in the part following the info to extract.
There are generally two somehow contradicting aims:
- be most specific to not match unwanted content
- be liberal to handle format changes
How did you develop the regex? It seems not to match as you liked. One way is
to build it step by step; starting with matching strings between p/p,
ckecking, be more specific, checking etc.
Note that I escape the '#' in the regex because of the /x modifier that allows
comments.
BEWARE: Id did not spend hours. It just extracts what you want from the $input
present.
#!/usr/bin/perl
use strict; use warnings;
my $input='
plib DATE FONT COLOR=#99TITLE1/FONT/b EVENT1
a href=http://www.mysite.comtarget=_new;www.mysite.com/a
[Ref #67579]/li/p
plib DATE FONT COLOR=#99TITLE2/FONT/b EVENT2
a href=http://www.mysite.comtarget=_new;www.mysite.com/a
[Ref #67579]/li/p
';
my %info = $input =~ m;
p\s*
li\s*
b.*?
font\s*color\s*=\s*\#99[^]*?\s*(.*?)\s*/font\s*
/b\s*(.*?)\s*a.*?/a\s*\[ref[^\]]+?\]\s*
/li\s*
/p
;mgxsi;
print map { $_ = $info{$_}\n } sort keys %info;
__END__
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Complex regex help
Omega -1911 am Freitag, 1. Dezember 2006 19:01: Hi Rob Dani, Hello Omega Thanks for your help!!! I will try the suggestion you made Rob and as soon as I finish typing this, I'll try Dani's code. I had someone contact me off-list and provided me with the following regex that appeared to work. Please let me know what you think: my( $title, $event) = $data_string =~ m|([^]*)(?:/FONT/b)([^\]]*)([^]*)|; First I'd like to emphasize that Rob's suggestion (use a parser module, not a regex) is really the preferred way. Consequently, I should not have mentioned a regex... I see at least the following problems with the above regex (there are others, as well as in mine): - It captures three peaces of the input, while on the left side are only two variables to put the peaces in. - When I run it, it matches too much into $event (event up to the Ref # without the trailing ']' - the latter is put in $3). - ... In short: A parser module will avoid a lot of trickiness, pitfalls, error proneness, problems [pick the right english term(s) if present] :-) Just forget the regex path. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Net::EasyTCP
Derek B. Smith am Freitag, 1. Dezember 2006 20:31: --- zentara [EMAIL PROTECTED] wrote: On Thu, 30 Nov 2006 13:34:16 -0800 (PST), [EMAIL PROTECTED] I need to gather a single filename on hundreds of servers ranging in *UX flavors from AIX, HP, [snip] I was initially thinking an scp command like so foreach my $server in (@servers) scp /etc/passwd /tmp/passwd.$SERVER but not all clients have ssh running and other nuances such as no root ssh sign-in, no ftp, and /etc/passwd is protected from downloads and reads by anyone but root. [snip] See: http://perlmonks.org?node_id=198680 Here is a version with a Tk front end: http://perlmonks.org?node_id=387351 ok but is it possible to emulate an ftp get from the master to retreive files from all clients w/out deploying the client code to all clients using this module? Hi Derek, Sorry for not providing an answer to your question (I *think* your question is answered by the manual. If not, wait for zentara :-) ) I may miss something but it may make the person(s) who are responsible for security nervous to hear of plans/thoughts - to transfer hundreds of passwd files unencrypted over the network - to place them in the /tmp directory with predictable file names - of seeing disallowed root login, locked down files, and missing ftp as a problem At least I would get nervous (although not having access to hundreds of boxes...) Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: no number return
Chris Parker am Donnerstag, 30. November 2006 14:57:
Adriano Ferreira wrote:
STDIN and then make a loop for them. So you should remove the
construction of @numbers from the loop, doing
Code now is:
print(Enter widths separated by spaces: \n);
my @numbers = split /\s+/, ;
for my $width (@numbers) {
my $result = calculate($width);
print(size = $width amount needed = $result \n);
}
Hello Chris
sub calculate {
my $a = $_;
This does not what you think it does. You can see that by placing the
following poor man's debug statement after this line:
print \$a=$a;
The solution's first step is to replace $a and $b by $x and $y (or whatever),
because $a and $b are special variables in perl, see perldoc -f sort.
Then, the line should be
my $x=shift;
or
my $x=$_[0];
Read perldoc perlsub for how arguments are passed to the sub.
There are other improvements and do nots in the code; your invited to get
your script do what it should and then reposting it :-)
Dani
my $value = $a / 12;
my $b = $value * $squareft;
return $b;
}
Here is the results:
Enter Total Square Footage: 1200
Enter widths separated by spaces:
2 3 4
Use of uninitialized value in division (/) at calc.pl line 23, line 2.
size = 2 amount needed = 0
Use of uninitialized value in division (/) at calc.pl line 23, line 2.
size = 3 amount needed = 0
Use of uninitialized value in division (/) at calc.pl line 23, line 2.
size = 4 amount needed = 0
It is pulling the size out nicely, but the value isnt making it into
the sub?? I have tried my $a = $_[0] , a = @_, a = $width and am lost
now.
thanks again
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Checking for infinite loops
hOURS am Donnerstag, 30. November 2006 21:09:
Jen Spinney [EMAIL PROTECTED] wrote: On 11/20/06, hOURS wrote:
Recently I posed a question on here regarding a program I have that
runs other programs (through require statements and what not). My
problem was that the programs getting run might have syntax errors and I
wanted to skip over each of those and go onto the next one. We figured
out a way to handle that. It turns out however, that these programs
sometimes have an even more troublesome problem: infinite loops. I knew
about this possibility, but figured I would just use the time function,
and if a program was taking to long, skip over it. Yeah, that wasn't so
smart. I can't have the main program check the elapsed time while the
required program is running its infinite loop. Or can I somehow? Any
ideas anybody? Thank you.
Fred Kittelmann
Fred,
Have you checked out the alarm function? I'm a beginner myself and I
had a similar problem earlier today. alarm seemed to do it for me.
Good luck!
- Jen
Thanks Jen,
I've checked out alarm as much as I can. My PERL textbook scarcely
mentions it. Trying perldoc -f alarm was a little more informative, but
I still don't understand how to use this. Can anyone explain it to me?
Fred
Does the following modified code example from 'perldoc -f alarm' helps?
Dani
#!/usr/bin/perl
use strict;
use warnings;
my $timeout=5; # secs
eval {
# Assign a signal handler subroutine which is invoked in case
# the alarm signal is sent
#
local $SIG{ALRM} = sub { die alarm\n }; # NB: \n required
# send an alarm signal after $timeout seconds!
#
alarm $timeout;
# to test a non-timeout die, uncomment following line:
#die;
# the problem:
#
endless_loop();
# reset alarm timer: Don't send alarm signal any more
#
alarm 0;
};
# Check if the code within eval died because of an alarm signal
# or something else. We check the die message for that.
#
if ($@) {
if ($@ eq alarm\n) {
warn endless_loop() interrupted after timeout\n;
}
else {
warn code in eval died!\n;
die;
}
}
warn program continues...\n;
sub endless_loop { {} while 1 }
__END__
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: delete function
Sayed, Irfan (Irfan) am Mittwoch, 29. November 2006 08:34:
I have two arrays . one array contains the element which needs to be
deleted from the secound array in which that element is already present.
I have tried using delete function but somehow i did not succeed.
Did you check how somehow it failed? You could have used Data::Dumper to see
the effect of delete $array[$i]. See also
perldoc -f delete
Here's one way to do it. remove() takes references to the array for speed.
The sub could be adapted, f.ex to return a modified copy of $targ instead of
changing it directly, and/or return the number of actually deleted elements,
and/or the elements that could not be deleted.
#!/usr/bin/perl
use strict; use warnings;
my @wanted=qw / a c /; # delete this...
my @target=qw / a b c d /; # ...from this
# deletes contents of second array from first
# $targ is directly changed. Preserves order.
#
sub remove {
my ($targ, $want)[EMAIL PROTECTED];
ref($targ) eq 'ARRAY' and ref($want) eq 'ARRAY'
or die 'wrong usage'; # check arguments
my %tmp=map {$_=1} @$want; # to make lookup faster
@$targ=grep { !exists $tmp{$_} } @$targ;
}
remove ([EMAIL PROTECTED], [EMAIL PROTECTED]);
print @target, \n;
__END_
There may be a more direct way.
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: failed substitution
Beginner am Dienstag, 28. November 2006 11:55:
[snipped for brevity, sorry]
Thanx Dani and John,
I should have realised that the that I was making the substitiution
on the full path and not the basename.
I appreciate you showing me how to shorten the code. Can I ask if I
am reading it right.
foreach my $basef (map basename ($_), @files) {
(my $l) = ($basef =~ /([a-z]{1,2})\.jpg$/);
Does this basename everything in @files and make it $basef?
Yes, every file in @files is piped through map witch applies the basename
function, and the result is stored in $basef, used within the foreach loop.
For the powerful map function see:
perldoc -f map
In John's example I am not sure what is happening with this RegEx:
( my $new = $f ) =~ s/([a-z]{1,2})(?=\.jpg\z)/_a/;
First, $f is copied into $new and the regex is applied to $new.
(?=something_here) is a positive lookahead not actually matching
something_here. The regex sais:
match one or two a-z chars that are followed by the string '.jpg', and
replace this/these char(s) with '_a'. See
perldoc perlre
There are 2 sets of parentheses but one lvalue, $new. So is that any
character a-z, 1 or 2 times and the ? mean 1 or more times?
No, the question mark is part of the '(?=)' construct, all described in
perlre.
What is the \z switch here? I can find it is perlre.
It's under the paragraph Perl defines the following zero-width assertions
(btw, at least on linux, you can call the search funktion by typing a '/'
while viewing)
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: goto return ?
JupiterHost.Net am Montag, 27. November 2006 21:37:
What about doing this?
return if do_one_then_two($whatever);
...
sub do_one_then_two {
my $what = $_[0];
if ($what) {
one();
two();
return 1;
}
return 0;
}
Thanks, I'm not looking for how to handle a condition necessarily.
Dear JupiterHost.Net
I want to be able to:
log_error_and_return($error, @return) if $whatever;
That's what you want? And it should return @return?
instead of
if($whatever) {
log_error();
carp $error;
return @return;
}
basically I want to override return to log and carp first, every time
its called.
Ok, another try (I would not use it myself):
sub my_return {
my ($error, $return_data)[EMAIL PROTECTED];
# do what boss wishes today
return $return_data;
}
# unconditional usage:
#
return my_return($error, $return_data);
# conditional usage:
#
return my_return($error, $return_data) if $whatever;
foo() unless returned_above();
I think you have to explicitly use the return. Otherwise, Tom Phoenix's notes
apply.
It's a really good thing to see 'return' at exactly the place where the code
does (or can) return to the caller.
I'm not sure if glueing together such different things as handling error
messages and returning application data is a good thing...
Do you now of the possibility to override $SIG{__WARN__}? This would allow to
keep recommended and usual coding style.
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: matching sets and ids
Himanshu Ardawatia am Sonntag, 26. November 2006 11:49:
Hi,
Hi
I have two files :
File A contains the following :
9,(6,8)),((4,((3,2),1)),5)),(12,11)),(13,(7,10)));
File B contains the follwoing:
1 A
2 B
3 C
4 D
5 E
6 F
7 G
8 H
9 I
10 J
11 K
12 L
13 M
Based on the file B, I want to modify the file A such that all numerics in
file A get changed to the alphabets in column 2 of file B (by mapping
column 1 of file B to file A) such that file A is effectvly modified to :
I,(F,H)),((D,((C,B),A),E)),(L,K)),(M,(G,J)));
Is there a way of doing it in perl ?
Certainly!
#!/usr/bin/perl
use strict;
use warnings;
my $str='9,(6,8)),((4,((3,2),1)),5)),(12,11)),(13,(7,10)));';
my %subst=qw( 1 A 2 B 3 C 4 D 5 E 6 F 7 G 8 H 9 I 10 J 11 K 12 L 13 M );
$str=~s/(\d+)/$subst{$1}/g;
print $str;
__END__
perldoc perlre
perldoc perlop
To avoid the impression that this list is a script service: Try to
initialize %substr from file and process the input file line per line.
If you then have further questions, please provide what you tried and ask
again :-)
See
perldoc open
perldoc close
perldoc chomp
perldoc -f while
Hope this provides a start!
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Problem with replacing string in file
perl pra am Samstag, 25. November 2006 13:40:
hi Gurus,
I have a problem to replace strings of file thru perl script.
[...]
I have a text file some thing like this..
PROJ_FOLER=C:\Proj
PROJ_LOGS=C:\PROJ\LOGS
I have same line in config file some thing like this.
PROJ_FOLDER=D:\Proj
PROJ_LOGS=D:\PROJ\LOGS.
[...]
Here is the code i have written...
Hi perl pra
I did not test your code, and won't present a solution, because I think it is
more helpful to make you think about what you coded, and how you can simplify
coding, and then you will find the solution yourself :-)
#!/usr/bin/perl
Never forget:
use strict;
use warnings;
you have to declare all variables now, and will see warnings and hints about
possible error sources.
my $config_path=E:/MessageArchive/WorkArea/config.txt;
$file=E:/temp/FT/config/FTMessageArchive.configd;
open FH, $config_path;
Replace the couble qoutes with single qoutes in the first two lines, no
variable is interpolated; in the third, a variable without any static text is
unnecessarily interpolated, so you can omit quoting at all.
Note the usage of FH and $LOGFILE as file handles. In newer style, use a
variable:
open my $fh, '', $config_path or die $!;
while ($line=FH) {
my ($key,$val)= $line =~ /^(\w+)=(.+)$/mg ;
The test if the matching succeeded is missing. Your data may be proper
formatted or not. If not, $key and $val will be undefined, leading to
unexpected results in the following code. Never assume properly formatted
input data.
You only read one line, so the /m modifier is useless.
A data line, I assume, should only have one 'X=Y', so the /g modifier is a bit
strange. You may want to handle unexpected data lines in some way.
$repline=$key=$val;
You break $line into parts and then put it together in $repline again. I don't
see at the moment what's the sense behind it?!
open $LOGFILE, '', $file;
*Always* check:
open $LOGFILE, '', $file or die $!; # even better: more verbose msg
while ($line1 = $LOGFILE ) {
if ($line1 =~ m/$key/){
system(perl -i.bak -p -e 's/$line1/$repline/g' $file);
*Always* check. system returns 0 on success.
Then, the error messages you get, indicate that the code given to system
contains some errors. What to do? Simply print out it to see what you pass to
system. Eventually run the code directly in the shell.
You deal with user provided input here that is passed to the shell. So be
*very* cautious about what is executed, and consider malicious input data.
Also note that you are in a while loop stepping through $file, and you try to
modify $file via system. Generally it's a bad idea to alter something you're
looping through.
close $LOGFILE;
*Always* check.
last;
}
}
}
close(FH);
*Always check.
END _
if i run the script I am getting the following errror..
Can't find string terminator ' anywhere before EOF at -e line 1.
Can't find string terminator ' anywhere before EOF at -e line 1.
Can't find string terminator ' anywhere before EOF at -e line 1.
[...]
What am i doing wrong?
The most important point I think is that you should check as much as possible
and assume as less as possible :-)
Then, as a next step, you may consider a redesign. Consider (poor pseudocode):
while ...{
while ...{
system...
}
}
I don't know how many lines your files contain, but system could be executed
numerous times, every time creating a new process!
Dani (nonguru)
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re [driving OT]: Free Perl Editor
Octavian Rasnita am Freitag, 24. November 2006 08:36: From: D. Bolliger [EMAIL PROTECTED] Emacs / Xemacs can do that all; [snipp] I have installed it, but it is very inaccessible for screen readers Hello Teddy/Octavian Can't help here since I'm without any win installation since 2000. and the keys combinations used are same complicated as under Unix. I don't even know what C-X C-F means. I have tried Control+C, Control+F, but nothing happend. Control+X, Control+F (note the X not C) ? After opening a file using the menu options, I couldn't read anything using the arrow keys. I don't know what you mean by reading using the arrow keys ?!? I can't provide any help on installing/problems on windows. Apologies for the off-topicness, my bad english and the lack of discriminating argumentation: I'd like to try to write down some thoughts concerning the different philosophy/approach in windows and *nix, (usage and software). Yes, the learning curve with many *unix style software (especially those with a long history, emacs being one of them) is steeper. While (my personal opinion of course) the windows interpretation of user friendlyness is instanteously usable with minimal preparation, on *nix it's more like useful and very efficent in the long term (although this difference is getting smaller as linux distributions get more mainstream/spread). Once accustomed to the comfortable unnecessity of switching between keyboard and mouse, or even using the mouse at all, you have a swiss army knife at hands, allowing you to be very efficient and flexible. Having chosen the right software (or problem solving strategy), you will hardly come into the situation oh, the requirements have changed in an unexpected manner, I need a different software designed for this peculiar variant. In short: For sombody not only casually using his PC, it's worth the initial higher expediture. At least this is my personal experience. Again, sorry for not being able to help you further and the off-topicness. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: failed substitution
Beginner am Freitag, 24. November 2006 14:48:
Hi,
I have a number of jpegs I wanted to rename. I wrote a short script
to do it but the new file name is not always generated correctly. The
script should find the last letter in the filename (before the
extension) and substitute it for '_a'.
Hi Beginner
I assume that you mean substitue with _a.
If you look at the results below you'll see that 'a' and 'b' fail but
'c' worked. I don't understand why.
DSC00092a.jpg - DSC00092a.jpg a
DSC00093b.jpg - DSC00093b.jpg b
DSC00094c.jpg - DSC00094_a.jpg c
DSC00095d.jpg - DSC00095d.jpg d
DSC00096e.jpg - DSC00096e.jpg e
DSC00097f.jpg - DSC00097f.jpg f
DSC00098g.jpg - DSC00098g.jpg g
DSC00099h.jpg - DSC00099h.jpg h
DSC00100i.jpg - DSC00100i.jpg i
DSC00101j.jpg - DSC00101_a.jpg j
DSC00102k.jpg - DSC00102_a.jpg k
DSC00103l.jpg - DSC00103l.jpg l
...snip
Here the script, there isn't much to it. Can anyone explain why the
substitute fails?
I should not mention that in the public ;-) but, just to demonstrate one way
to search for a reason for a malfunction:
Because I did not see an error at first glance, I...
#!/bin/perl
# Active State 5.8.6.811
use strict;
use warnings;
use File::Basename;
my $dir = 'D:/Temp/jpegs/thumbs/';
my @files = glob(${dir}*.jpg);
...replaced these two lines with simply
my @files=qw(DSC00092a.jpg DSC00094c.jpg); # etc
and everything worked fine.
Then, I created these files in the current directory, and again everything
worked fine.
Then, I made a subdirectory, moved the file over, ...
foreach my $f (@files) {
(my $l) = ($f =~ /([a-z]|[a-z][a-z])\.jpg/);
(my $new = $f) =~ s/$l/_a/;
...placed here a
warn new=$new;
and got (excerpt):
new=/home/d_ani/ramsch/thumbs/DSC00092a.jpg at ./script.pl line 17. # !!
new=/home/dani/ramsch/thum_as/DSC00093b.jpg at ./script.pl line 17. # !!
new=/home/dani/rams_ah/thumbs/DSC00094c.jpg at ./script.pl line 17. # !!
new=/home/dan_a/ramsch/thumbs/DSC00100i.jpg at ./script.pl line 17. # !!
new=/home/dani/ramsch/thumbs/DSC00101_a.jpg at ./script.pl line 17.
my $basef = basename($f);
my $basenew = basename($new);
print $basef - $basenew $l\n;
}
And now it's extraordinary obvious that the error is
(my $new = $f) =~ s/$l/_a/;
which simply searches for the first char contained in $l and replaces it
with '_a'. This makes the malfunction dependent from the contents in $dir.
Instead, this line should be more specific, f.ex:
(my $new = $f) =~ s/$l\.jpg$/_a\.jpg/;
(Note that I anchor with $ since DSC00092a.jpg is a valid path name :-) )
Of course it would have been sufficient to only present this last substitution
to lead you to a aha!, but I think it's important to have a personal
strategy to search for errors in the dark :-)
btw, the foreach code can at least be shortened to:
foreach my $basef (map basename ($_), @files) {
(my $l) = ($basef =~ /([a-z]{1,2})\.jpg$/);
# above line is still problematic: What if the match failes?
(my $basenew = $basef) =~ s/$l\.jpg$/_a\.jpg/;
print $basef - $basenew $l\n;
}
and certainly optimized further in several ways (f.ex if you don't need the
last print statement, $l could possibly be eliminated), but I'm so tired and
brain dead at the time :-)
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: postgres insert
Tom Allison am Donnerstag, 23. November 2006 16:13:
[snipped some code]
I get a STDERR warning printed out everytime this has a duplicate key
violation...
Any idea why eval{} doesn't suppress this?
Hi Tom
It'd be a bad idea... eval BLOCK adds the ability to catch runtime errors and
modify the default reaction to a die. It is not here to hide any problems of
code.
You can suppress the output of warnings at a certain place by f.ex:
#!/usr/bin/perl
use strict; use warnings;
warn Test1\n;
{
local $SIG{__WARN__}=sub {}; #
warn Test2\n;
}
warn Test3\n;
__END__
output:
Test1
Test3
Dani [not part of the output...]
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Free Perl Editor
Octavian Rasnita am Freitag, 24. November 2006 06:17: From: Paul Brasseur [EMAIL PROTECTED] Try PSPad ! It is a Great Perl/PHP Editor. It has many nice Features such as Permanent and Descriptive Bookmarks, add a Comment to Line(s), Code Explorer Window. It easily can be set to run Apache and/or Xitami. It is written by a Computer Science Instructor in Eastern Europe. Ok. I will need to study it a little better, because I couldn't find how to run a perl program with it. I just want to use a key combination (like Control+Shift+R), a pop-up window prompting for parameters should appear, and after typing the parameters and hit enter, the results or the errors should be printed in another document-window which should be created. Is this possible with PsPad? Hi Octavian Emacs / Xemacs can do that all; check syntax, run with output in new window, rcs/cvs integration, syntax highlighting, automatic (and of course customizable) source formatting support... And it has much much *much* more features I don't know/use yet! It's not only a perl editor, it's an all purpose editor. (Can't compare to vim since I only use nano or vi in a terminal for system admin) Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Killing a process that takes too long
Jen Spinney am Dienstag, 21. November 2006 22:06:
On 11/21/06, Jen Spinney [EMAIL PROTECTED] wrote:
On 11/21/06, Tom Phoenix [EMAIL PROTECTED] wrote:
On 11/21/06, Jen Spinney [EMAIL PROTECTED] wrote:
I want to make a system call, and then kill the process if it takes
too long.
So, if I do a ps -af, I can see that my perl script is a goner, but
the process spawned from the system call is still alive.
Yes; if you use system() to start a sub-process, you're letting perl
manage it; so there's no way to get the process-ID.
You may instead use fork and exec; this lets you use the process-ID to
manage the process directly. Be sure to use wait or waitpid to reap
the completed child process, so as not to leave zombies.
Is that what you needed? Hope this helps!
--Tom Phoenix
Stonehenge Perl Training
Thanks Tom!
I replaced the system call with fork and exec and it works just the
way I want it to:
use warnings;
use strict;
my $pid;
eval {
local $SIG{ALRM} = sub {
print Timed out\n;
kill 'INT', $pid;
die 'alarm';
};
alarm 5;
if ($pid = fork)
{
waitpid ($pid, 0);
}
else
{
exec ('sleep 45');
}
alarm 0;
};
die if $@ $@ !~ /alarm/;
print Exited normally.\n;
__END__
For my actual program, I had to do a bit more work because I have
semicolons and other shell stuff in the command (which seems not to do
so well with exec?), but I figured out a workaround.
So, thanks again!
- Jen
Sorry for top-posting my last post. I ran into a bit of snag when
replacing system with exec. If you replace 'sleep 45' in my last post
with perl -e 'while (1) {print 1}' | tee test.txt, the pipe really
messes things up. Can anyone give me guidance as to how I should set
up a pipe when using fork () and exec () to replace system ()? Do I
have to call pipe ()? I'm a beginner programmer, so this low-level
stuff is somewhat scary and foreign to me.
Hello Jen, hello IPC gurus :-)
I'm not a specialist in this area, and took the opportunity to play around a
bit - someone will correct me where I'm wrong, explain more - and give an
example using modules ;-)
You find a modified script at the bottom, which, as I can see, does what you
want.
I think your original script has several problems:
The SIGINT can be blocked, and it does not guarantee that the (any) child
ends. The same holds for SIGTERM. The only signal that guarantees the child
end is SIGKILL - but it's not recommended to use SIGKILL by default because
it may hinder the killed process to proper clean up.
I'm not sure, but the best way would probably be to try SIGINT, wait, try
SIGTERM if process still alive, wait, then SIGKILL if still alive.
But in your script(s), SIGINT works.
The code in the SIGHANDLER should be as short as possible (if this still holds
true nowadays). That's why I modified it to only set the $finish variable to
true; it's value is checked elsewhere in the code, and a timeout() sub is
called that does the actual work of killing the child.
The two statements after the eval block are executed by the parent *and* the
child. You can test it by placing $$ (process pid) in the output of these two
statements. That's why I placed an exit after the exec in the child process.
Your check for $@ containing 'alarm' uses !~ instead of =~ :-)
After replacing 'sleep 45' (which creates one single child process) with
perl -e 'while (1) {print 1}' | tee test.txt, the fork leads to following
processes (ps ax output snippet):
8827 pts/11 S+ 0:00 /usr/bin/perl ./script.pl
8828 pts/11 S+ 0:00 sh -c perl -e 'while (1) {print 1}' | tee test.txt
8829 pts/11 R+ 0:01 perl -e while (1) {print 1}
8830 pts/11 S+ 0:00 tee test.txt
After the timeout, pid 8828 (forked from 8827) is killed, but 8829 and 8830
(the grandchild processes) are still running.
So we need a way to kill several processes of the process group of the parent,
but not the parent itself.
The way I found after consulting
perldoc -f kill, man kill and perldoc perlipc
is to
a) in the parent: ignore the INT and TERM signal
b) sending the signal to the whole process group
(see timeout()).
I hope this helps a bit and is corrected if necessary
==
#!/usr/bin/perl
use strict;
use warnings;
my $pid;
my $finish=0;
# actions after timeout to keep SIGHANDLER short
#
sub timeout {
print Timed out pid $pid\n;
# kill the process group, but not the parent process
local $SIG{INT}='IGNORE';
local $SIG{TERM}='IGNORE';
kill 'INT' = -$$;
# eventually try also with TERM and KILL if necessary
die 'alarm';
}
eval {
local $SIG{ALRM} = sub { $finish=1 };
alarm 5;
die Can't fork! unless defined ($pid=fork); # check also this!
if ($pid) { # parent
warn child pid: $pid\n;
# Here's the code that checks for the timeout and do the work:
Re: pattern substitution
Adriano Allora am Samstag, 18. November 2006 11:52:
hi to all,
Ciao Adriano
I've got a list of tagged words, like this one (only a little bit
longest):
tLn nr=11
e CON e
le DET:def il
ha VER:presavere|riavere
detto VER:pperdire
NOM unknown
CORRVER:inficorre
NOM unknown
e CON e
a PRE a
I need to transform the list below in (in which the CORR tag isn't
tagged):
tLn nr=11
e CON e
le DET:def il
ha VER:presavere|riavere
detto VER:pperdire
CORR
e CON e
a PRE a
So I tried to write this awful script:
#!/usr/bin/perl -w
use strict;
$^I = '';
my $tic = 0;
my $toc = 0;
while()
{
if(/^ NOM unknown.*/i)
You don't need the .* in the regex here (and below).
{
$tic = 1;
next;
}
next if /^ NOM unknown.*/i;
next if $toc == 1;
$toc can only have the values 0 and 1. So, if you get here, $toc is 0...
$toc = 0;
...and this won't change $toc.
if($tic==1)
{
s/^(\/?\w+).+/$1/gi;
chomp();
$_ = $_;
$toc = 1;
$tic = 0;
}
s///g;
print;
}
it doesn't return errors, but it stop printing the output after the
first correction. Someone can explain me why
Didn't look deeply enough in the code, so I can't :-)
and eventually suggest how to correct the corrector?
The script below seems to do what you want. It's not very elegant, but (I
think) easy to understand. I use a $inside variable that does what you maybe
intended with $tic and $toc.
PS: another strange thing: if I declare at the beginning of the script:
my($tic,$toc); it returns me an error...
You don't say what error, but I got errors like
Use of uninitialized value in numeric eq (==) at ./script.pl line 19,
DATA line 1..
$tic/toc is used in a numeric comparison before a value has
been assigned (my ($tic, $toc) leaves both undefined). The program flow may be
different from what you expect, and maybe also the reason for a stop after
the first correction.
I hope this helps,
Dani
#!/usr/bin/perl
use strict;
use warnings;
my $inside; # are we within a tagged area?
while(DATA) {
if (/^\s+NOM\s+unknown/i) {
$inside=1;
next;
}
elsif (/^\s+NOM\s+unknown/i) {
$inside=0;
next;
}
elsif ($inside) {
my ($str)=/(^\w+)/ or die;
print $1\n;
}
else {
print;
}
}
__DATA__
tLn nr=11
e CON e
le DET:def il
ha VER:presavere|riavere
detto VER:pperdire
NOM unknown
CORRVER:inficorre
NOM unknown
e CON e
a PRE a
tLn nr=11
e CON e
le DET:def il
ha VER:presavere|riavere
detto VER:pperdire
NOM unknown
BLAVER:inficorre
NOM unknown
e CON e
a PRE a
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: line position
Tim Wolak am Freitag, 3. November 2006 18:37:
All,
I need to parse lines from a file and at a certain position test to see
if it is what a want, if so I need to grab information from other
positions in the line and drop it into a file. As I have never done
this before, can someone point me in the right direction as to get
started?
Thanks for the help!
Tim
Hello Tim
I've read your second post with some sample data.
Here's one way to do it, certainly not the most efficient, but it's short and
you can adapt it to your needs. I use shorter sample data and other
positions, but you get the idea.
I use, for shortness, the DATA filehandle. You may want to adapt it to use
STDIN for input and print to STDOUT, so you can invoke the script with
$ script.pl infile outfile
What it does: It skips 4 positions, tries to match 'hi' or 'ho' at the next 2,
then skips 3, retrieves the next 2, skips again 8, and retrieves the next 6.
The retrieve is done via capturing paranthesis, see perldoc perlre.
Hope this helps,
Dani
#!/usr/bin/perl
use strict;
use warnings;
while (DATA) {
if (my (@out_fields)= $_ =~ /^ .{4} (hi|ho) .{3} (.{2}) .{8} (.{6}) /x) {
print @out_fields, \n;
}
}
__DATA__
hi33322first*
ho33322second
no33322third*
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Interpolation of backslash-escapes
Peter Daum am Freitag, 3. November 2006 20:26:
Hoi Peter,
I am looking for an way to interpolate backslash-sequences
within a string with the usual perl semantics, e.g.
$s='1\t\2\t3\na\ b c' should become:
'1tab2tab3
a b c'
With usual perl semantics, the result is different :-)
Things I tried were for example
$s= eval('' . $val); # (hoping to trigger the normal interpolation) or
$s=~ s/\\(.)/\\$1/eg;
but somehow i couldn't get it right ...
Can anybody think of an elegant solution?
I think there are more elegant solutions, but in the following you have full
control over what translates to what:
#!/usr/bin/perl
use strict;
use warnings;
my %trans=(
'\t'=\t,
'\n'=\n,
'\ '=' ',
'\2'='2',
q(\\)=qw( \ ), # ;-)
);
my $s='1\t\2\t3\na\ b c \\\ '; # last space: ;-)
$s=~s; (\\.) ; $trans{$1} || $1 ;gex;
print $s\n;
# Note the usual perl semantics:
print \2\ \n;
__END__
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: line position
Wagner, David --- Senior Programmer Analyst --- WGO am Freitag, 3. November
2006 22:16:
If it is only one line and it is record separator is carriage
return as defined by your system, then a simple loop like:
Hello David and Tim,
The below code is a good example why one should happily place:
use strict;
use warnings;
at the beginning.
while: ( MYFILEIN ) {
You meant:
while ( MYFILEIN ) {
chomp;
Just omit the chomp and the code behaves the same.
if ( substr($_,70,2) =~ /(xx|xy|xz)/I ) {
The modifier should be /i, not /I. With /I, the code doesn't even compile.
If you want to use a regex, then it might be better to:
- anchor the pattern (not completely shure though if
that makes a difference *here*)
- stop the matching process immediately after the first char does
not match
- use non-capturing parenthesis (?:) to decrease the work
of the regex engine, since the matched string is not used
- Then, since the same substring is used below, it might (not shure)
be appropriate to store the extracted string into a variable
That would leed to [untested]:
if ( (my $s=substr($_,70,2)) =~ /^x(?:x|y|z)/i ) {
print MYFILEOUT substr($),70,2) .
You meant '$_', not '$'.
print MYFILEOUT $s . # see above alternative
Substr($_,91,1) . \n;
You meant:
substr ($_,91,1) . \n;
}
}
simple format and should be straight forward.
Dani
[snipped top-posting history]
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Find all matches in a string via regex
C.R. am Dienstag, 31. Oktober 2006 17:20:
In article [EMAIL PROTECTED], [EMAIL PROTECTED] says...
You need to show us your code Chuck. Perl doesn't do that, in any
situation that I can think of. Try running this on its own:
my $s = '144 cm';
$s =~ s/(\d+ +cm)/bx;1$1ba/g;
print $s;
I get
bx;1144 cmba
what do you get?
That may help on its own. If not, like I said, post the relevant part of
your code.
Your example above is extremely simple, and simply does not apply to my
situation. But yes, that code above will work on my version of Perl,
becasue Perl is only replacing one instance of /\d+ cm/. My situation is
more complicated where I need to replace MULTIPLE instances of /\d+ cm/
in a single string.
My first post in this thread shows example data as it is stored in a
scalar variable. It also shows what the string SHOULD look like after
the substitution.
Or maybe, perl simply is not able to replace multiple instances of a
regex expression in a single scalar/string variable.
$s=54 x 34 x 30-3/4 Hl137 x 86 x 78 cmlKneehole Height: 24-1/2``
(62 cm)lChair height: 30-3/4 (78 cm)l;
(Don't worry about special strings like l, they are used by our
typesetting software.) Notice that 78 cm appears twice, both should
have bx;1ba around them.
$s should end up like this:
54 x 34 x 30-3/4 Hl137 x 86 x bx;178 cmbalKneehole Height:
24-1/2`` (bx;162 cmba)lChair height: 30-3/4 (bx;178 cmba)l
Notice the insertion of bx;1 and ba around strings that match
/\d+ cm/.
Hello Chuck (again)
Have a look at the code of your first posting:
[Chuck:]
while ($s=~m/\d+ +cm/g)
{
$old=$; # Save current match.
$new=$old;
$s=~s/$old/bx;1$newba/;
} # while
That's too complicated and thus also error prone. You don't need a loop to
replace all occurances in a string. The /g modifier is here to do that.
Simply replace /all/ above lines with:
$s=~s/(\d+ +cm)/bx;1$1ba/g;
(or any of the variants presented by others)
I hope this helps.
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Need to pull matched string plus a few additional bytes
Phil Miller am Freitag, 27. Oktober 2006 15:36:
I am working on my very first program and have run into a bit of a
roadblock. I am trying to print a report of users who show up in an IIS
Log file. The good news is that the format of the userid is
WINDOWSDOMAIN\USERID. The bad news is that it is not always at the same
place in the IIS Log file due to some variable length fields that come
before it. Its location can vary left or right by about 10 bytes.
I read the IIS Log file in one line at a time. I have gotten far enough
that I can identify the lines with WINDOWSDOMAIN on it, but am stuck
there. The code $userid = substr($logfile_in, 33, 12); gets me close
but depending on the length of the date, the time or the IP address, it
is usually off by a few bytes. A sample of the input is below to
explain what I am talking about.
2006-10-23 12:08:47 24.32.35.123 WINDOWSDOMAIN\USERID 175.128.127.43 80
GET /itd/styles/main.css
2006-10-23 12:08:47 24.32.35.123 WINDOWSDOMAIN\USERID 175.128.127.43 80
GET /itd/styles/contents.aspx
2006-10-23 12:08:47 24.32.35.123 WINDOWSDOMAIN\USERID 175.128.127.43 80
GET /itd/styles/footer.aspx
Essentially what I need to do is find the WINDOWSDOMAIN on a line, and
write to a file the matched string plus \USERID data (up to the next
space). Does anyone have any suggestions? I'm thinking there must be
some very easy way to do it since Perl is made for this sort of thing.
I remember reading about some Perl built-in capability that would take a
scalar variable and parse it into an array based on a delimiter, but I
can't remember what it is. That would probably do it for me. But if
you know of a better way, I'm all ears.
Here's demonstration code how you can do it with a regex or with split.
The code assumes that the GET line and the line above are on one line in the
log.
The two demonstration subs return 1 on match and 0 otherwise, so the counter
can be updated by the subs' return value.
The $miss_counter is calculated only once, from the hits and the number of
lines read.
The data after __DATA__ may be wrapped by your mail client (4 lines).
I'm not sure if WINDOWSDOMAIN is meant as a hardcoded constant.
#!/usr/bin/perl
use strict;
use warnings;
# see perldoc perlre
#
sub do_regex {
$_=shift;
if (m; \w+ \\ (\w+) .* \s/itd/ ;ix) { # NOT OPTIMAL!
print userid (regex): $1\n;
return 1;
}
return 0;
}
# see perldoc -f split
#
sub do_split {
$_=shift;
my @parts=split;
if ($parts[7]=~m;/itd/;i) {
if ( my ($domain, $userid)=split m;\\;, $parts[3] ) {
print userid (split): $userid\n;
return 1;
}
}
return 0;
}
my $hit_counter=0;
while (DATA) {
$hit_counter+=do_regex($_);
do_split($_);
}
my $miss_counter=$.- $hit_counter;
print hits: $hit_counter / missed: $miss_counter / read: $. lines\n
__DATA__
2006-10-23 12:08:47 24.32.35.123 WINDOWSDOMAIN\USERID 175.128.127.43 80 GET
/itd/styles/main.css
blubb blubb foo bar dummy asdf 44 44 55 66
2006-10-23 12:08:47 24.32.35.123 WINDOWSDOMAIN\USERID 175.128.127.43 80 GET
/itd/styles/contents.aspx
2006-10-23 12:08:47 24.32.35.123 WINDOWSDOMAIN\USERID 175.128.127.43 80 GET
/itd/styles/footer.aspx
==
Some random annotations to your code (there are others as well),
UNTESTED:
Below is the code I am using.
# with the following statements your life will be easier!
#
use strict; use warnings;
open USERIDOUT, userid.out.txt;
# perldoc -f open
# perldoc perlvar
#
open my $outf, '', 'userid.out.txt' or die $!;
open IISLOG, ex061023.log;
open my $log, '', 'ex061023.log' or die $!;
$ctr = 0;
$hit_counter = 0;
$miss_counter = 0;
$logfile_in;
$userid;
Put my in front of all these declarations/definitions.
while (IISLOG)
while ($log)
{
$logfile_in = $_;
if ( ($logfile_in =~ m/WINDOWSDOMAIN/i $logfile_in =~
m/itd/i)
I think you can omit on () pair here.
)
{
print \n** Found success\n;
$hit_counter += 1;
# same as
#
$hit_counter++;
$userid = substr($logfile_in, 33, 12);
# This is not correct but is somewhat close
print \n, $userid;
}
else
{
print Did not find success\n;
$miss_counter += 1;
}
}
print \n Hit Counter = , $hit_counter;
print \n Miss Counter = , $miss_counter;
print \n Total Records Counter = , $hit_counter + $miss_counter;
close USERIDOUT;
close $outf or die $!;
close IISLOG;
close $log or die $!;
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Fw: Reg:need to find the particular pattern in a line and assign to variables.
pradeep reddy am Mittwoch, 25. Oktober 2006 09:02:
John,
Thx for your inputs.
1st i/p:
Hello
please don't top post so the discussion can be followed easily.
Iam afraid, I cant read each line from array problemLines to outLine.
You don't show how you modified your code after John's advice.
foreach (@problemLines) { # for all lines do:
# handle the current line in $_
# [no need for the $outLine variable]
}
2nd i/p:
=~ /([^]+)/g;--What is the logic in this expression?
Can u bit ellaborate.
I wanted to read the values in double quotes, from each line.
It does what you want: Extract (by capturing with ()) all (/g) strings ([^]+)
between two double quotes (/snip/).
Look at the documentation (from command line): perldoc perlre
And , Iam using this logic ---if ($outLine =~ / cleartool: Error: Unable to
create label /)
, to check for the patten in part of line..Is this correct?
Spaces are relevant. According to your output below, there is no space
before cleartool.
To check if it's correct, simply try it and look at the result.
Hope this helps!
Dani
[Original question JWK's 1st answer:]
- Original Message
From: John W. Krahn [EMAIL PROTECTED]
To: Perl Beginners beginners@perl.org
Sent: Wednesday, 25 October, 2006 12:11:02 PM
Subject: Re: Fw: Reg:need to find the particular pattern in a line and
assign to variables.
pradeep reddy wrote:
Hello all,
Hello,
Iam new member to this group and also beginner to PERL.
Here is my question,plz let me know your inpus:
I have a PERL script which gives error report at the end.
Here is the output.
cleartool: Error: Unable to create label Pradeep on
/vob/rootinclude/paer.c version /main/3. cleartool: Error: Unable to
create label Pradeep on /vob/rootinclude/pcme.h version /main/2.
I need to grab the two elements between the two quotes.
Iam very much beginer to the PERL script.
Iam trying this bit of code, not sure how to go on.
foreach (@problemLines) {
push $outLine,@problemLines; /here Iam trying to get the each line
into outLine/
The first argument to push() must be an array so that will not work.
if ($outLine =~ / cleartool: Error: Unable to create label /) {
/here Iam trying to match the pattern/ my @values = split('
',$outline);/Here Iam splitting the outline/ my $pathName =
@values[3];
my $Version = @values[5];
cleartool mklabel $RECURSE $REPLACE -version $Version $labelName
$pathName; /This is the comand Iam using/ print $_\n;
}
You probably want something like this:
my ( $labelName, $pathName, $Version ) = $outline =~ /([^]+)/g;
John
--
Perl isn't a toolbox, but a small machine shop where you can special-order
certain sorts of tools at low cost and in short order. -- Larry Wall
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Is that I can do something like that ?
Mug am Mittwoch, 25. Oktober 2006 13:12:
Hi all,
Hello Mug
I'm not shure if I understand your question...
I don't know if that anyway I can know what should I pass back
from right hand side to left hand side, like :
my $x = qw/a b c d e / ; # so I have $x = 5
The list on the right hand side is evaluated in scalar context, and that
delivers the number of entries in the list.
my ($x) = qw / a b c d e / ; # then I have 'a'
Here, the parenthesis provide list context to the right hand side. Perl tries
to assign the nth list entry to the nth variable (in the left hand side
list). Since the left hand side can only hold one value, only the first list
item is assigned, and the following are discarded.
or like
$data = F ; # reads 1 line from file;
Scalar context = assign one line. F behaves different than a list in scalar
context (does not result in the number of file lines). Consider:
my @array=(1,2,3,4);
my %hash =(1,2,3,4);
my @new=%hash;
my [EMAIL PROTECTED];
@data = F ; # reads all line from the file
list context = assign all lines
I actually want to write a piece of code like that :
my %u_info = user_detail ( $ENV{QUERY_STRING} );
# I have $u_info{id} = 'foo' , $u_info{pass} = 12345
my @attribs = user_detail ( $ENV{QUERY_STRING} );
# I have @attribs = ( 'foo', 12345 );
while I am asking %u_info , the user_detail will return a hash ,
and while I am asking @attribs, I got an array return.
Simply return a list, or an array, from the function. From the perspective of
the function, it does not matter if the list is assigned to an array or a
hash (provided an even number of elements).
But there is - in contrast - a way to find out from a subroutine if it's
called in scalar or list context:
return wantarray ? @list : $scalar;
Hope this helps
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Spam from this list
Ron Goral am Mittwoch, 25. Oktober 2006 13:45: Is anyone else receiving spam from this list? I use this email address only for this list, so it must be originating from someone on it. Any ideas? Public mailing lists having a searchable public archive present the poster's email address to the public (not only to the list subscribers), so they are, like any websites, a target for email collecting software. Searching your email in google groups: Results 1 - 4 of 4 for [EMAIL PROTECTED] (0.12 seconds) (this only shows that your email is archived, not how addresses are collected, of course) In short: That's absolutely normal, don't suspect the list subscribers to be spammers :-) Hope this helps Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Fw: Reg:need to find the particular pattern in a line and assign to variables.
pradeep reddy am Mittwoch, 25. Oktober 2006 13:52:
Hello,
This is code I used and it executed in a wanted way.
foreach $outLine(@problemLines) {
if ($outLine =~ cleartool: Error: Unable to create label ) {
my @values = split('',$outline);
my @label = @values[1];
my $pathName = @values[3];
my $Version = @values[5];
cleartool mklabel $RECURSE $REPLACE -version $Version $label $pathName;
}
Anyways, as per Bolliger's i/p I with try to use $_ instead of with outLine
varible.
It's not *necessary* to use $_ instead of $outLine, especially not in code
that already does what you want...
But I don't think that above code does what you want (from looking at it). For
example, there is no $label variable defined/assigned.
Put the following standard lines at the top of your script (after the shebang
line):
use strict;
use warnings;
and adjust the code according to the help that will show up :-)
Dani
P.S. Again, *please*, don't top post.
- Original Message
From: D. Bolliger [EMAIL PROTECTED]
To: beginners@perl.org
Sent: Wednesday, 25 October, 2006 4:36:10 PM
Subject: Re: Fw: Reg:need to find the particular pattern in a line and
assign to variables.
pradeep reddy am Mittwoch, 25. Oktober 2006 09:02:
John,
Thx for your inputs.
1st i/p:
Hello
please don't top post so the discussion can be followed easily.
Iam afraid, I cant read each line from array problemLines to outLine.
You don't show how you modified your code after John's advice.
foreach (@problemLines) { # for all lines do:
# handle the current line in $_
# [no need for the $outLine variable]
}
2nd i/p:
=~ /([^]+)/g;--What is the logic in this expression?
Can u bit ellaborate.
I wanted to read the values in double quotes, from each line.
It does what you want: Extract (by capturing with ()) all (/g) strings
([^]+) between two double quotes (/snip/).
Look at the documentation (from command line): perldoc perlre
And , Iam using this logic ---if ($outLine =~ / cleartool: Error: Unable
to create label /)
, to check for the patten in part of line..Is this correct?
Spaces are relevant. According to your output below, there is no space
before cleartool.
To check if it's correct, simply try it and look at the result.
Hope this helps!
Dani
[Original question JWK's 1st answer:]
- Original Message
From: John W. Krahn [EMAIL PROTECTED]
To: Perl Beginners beginners@perl.org
Sent: Wednesday, 25 October, 2006 12:11:02 PM
Subject: Re: Fw: Reg:need to find the particular pattern in a line and
assign to variables.
pradeep reddy wrote:
Hello all,
Hello,
Iam new member to this group and also beginner to PERL.
Here is my question,plz let me know your inpus:
I have a PERL script which gives error report at the end.
Here is the output.
cleartool: Error: Unable to create label Pradeep on
/vob/rootinclude/paer.c version /main/3. cleartool: Error: Unable
to create label Pradeep on /vob/rootinclude/pcme.h version
/main/2.
I need to grab the two elements between the two quotes.
Iam very much beginer to the PERL script.
Iam trying this bit of code, not sure how to go on.
foreach (@problemLines) {
push $outLine,@problemLines; /here Iam trying to get the each line
into outLine/
The first argument to push() must be an array so that will not work.
if ($outLine =~ / cleartool: Error: Unable to create label /) {
/here Iam trying to match the pattern/ my @values = split('
',$outline);/Here Iam splitting the outline/ my $pathName =
@values[3];
my $Version = @values[5];
cleartool mklabel $RECURSE $REPLACE -version $Version $labelName
$pathName; /This is the comand Iam using/ print $_\n;
}
You probably want something like this:
my ( $labelName, $pathName, $Version ) = $outline =~ /([^]+)/g;
John
--
Perl isn't a toolbox, but a small machine shop where you can
special-order certain sorts of tools at low cost and in short order.
-- Larry Wall
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Is that I can do something like that ?
John W. Krahn am Mittwoch, 25. Oktober 2006 19:04: D. Bolliger wrote: Mug am Mittwoch, 25. Oktober 2006 13:12: I don't know if that anyway I can know what should I pass back from right hand side to left hand side, like : my $x = qw/a b c d e / ; # so I have $x = 5 The list on the right hand side is evaluated in scalar context, and that delivers the number of entries in the list. No it doesn't: $ perl -le' $x = qw/ a b c d e /; print $x' e That's the line I should have run before posting... thanks John, and sorry to Mug, a list behaves different than an array: $ perl -le' @y = qw/ a b c d e /; [EMAIL PROTECTED]; print $x' 5 Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Find all matches in a string via regex
C. Roberts am Mittwoch, 25. Oktober 2006 19:32:
I have Perl 5.6.1 on Sun Solaris.
I am processing a text file which will be imported into our
typesetting software. In our typesetting software I want to make
sure a number does not separate from its unit of measure. So I want
to keep 21 cm together by changing it to bx;121 cmba.
My problem is my perl variable contains multiple matches for the
pattern \d+ cm and I want to surround each match with bx;1 and
ba. Here is an example line before changing it.
54 x 34 x 30-3/4 Hl137 x 86 x 78 cmlKneehole Height: 24-1/2``
(62 cm)lChair height: 30-3/4 (78 cm)l
(Don't worry about special strings like l, they are used by our
typesetting software.) Notice that 78 cm appears twice, both should
have bx;1ba around them.
The line should end up like this:
54 x 34 x 30-3/4 Hl137 x 86 x bx;178 cmbalKneehole Height:
24-1/2`` (bx;162 cmba)lChair height: 30-3/4 (bx;178 cmba)l
I have tried the following code to loop through the matches but Perl
always finds the first instance only. Can anyone help me? I have
already done a Google search, only to find thousands of sites that
are of absolutely no use to me. And I have read some of the perl
docs, and those did not help me either.
sub fixdesc2
{my($l)[EMAIL PROTECTED]; # Pass in string to process.
my($s,$old,$new);
$s=$l;
while ($s=~m/\d+ +cm/g)
{
$old=$; # Save current match.
$new=$old;
$s=~s/$old/bx;1$newba/;
} # while
return $s; # fixdesc2
}
What about:
#!/usr/bin/perl
use strict;
use warnings;
while (DATA) {
s/(\d+\s+cm)/bx;1$1ba/g;
print;
}
__DATA__
54 x 34 x 30-3/4 Hl137 x 86 x 78 cmlKneehole Height: 24-1/2`` (62
cm)lChair height: 30-3/4 (78 cm)l
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Find all matches in a string via regex
C.R. am Mittwoch, 25. Oktober 2006 20:38: Well, that kinda worked. I had to change it to work on a scalar so this is what I wrote: $s=~s/(\d+ +cm)/bx;1$1ba/g; Input string: 144 cm Output string: bx;114bx;14 cmbaba Why did I get duplicate bx;1 and ba strings? Hm, I can't reproduce this (perl 5.8.8): $ perl -le 'my $s=q(144 cm); $s=~s/(\d+ +cm)/bx;1$1ba/g; print $s;' bx;1144 cmba What exactly did you do? Is the \G operator here ? and does v5.6.1 have it? Don't remember, sorry. Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: whiling through an array
Kathryn Bushley am Samstag, 21. Oktober 2006 21:43:
Hello again,
Thanks Tom Pheonix...I had put in a forward in place of backwards
slash...always a stupid mistake...one more question...I am able to
substitute the first value in my hash %id_global but doesn't substitute the
rest I think because it is only moving through the file once...I've
successfully split it into an array...how does one go about whiling through
the elements of an array (@TREE)?
open (TREE,$treefile)|| die can't open tree file: $\n;
typo: '$' instead of '$!'
my $line;
Can be declared within the while loop.
while (TREE){
foreach my $code (keys %id_global){
$line = $_;
This assignement should be placed outside the foreach loop
(see comment below)
$line=~s/(.*)$code([\D])/$1$id_global{$code}$2/g;
}
}
The locgical problem here is that after substitution in the inner foreach
loop, you discard $line and assign the original value from $_ for every
subsequent substitution.
Move the line $line = $_; above the foreach loop to avoid this.
Also, It *might* be an idea to replace (.*) [greedy] in the regex with
(.*?) [non-greedy], because it would try to replace multiple occurances
of a $code from first to last and not from last to first.
Hm... I think you can even omit the $1 part and just write:
$line=~s/$code([\D])/$id_global{$code}$1/g;
Btw: You follow the strategy: Search for all existent codes (in %id_global)
and replace if present (in $line). If there are much more entries in
%id_global than in a $line and the format of the codes can be specified
as regex, it might be more performant to change it to
Search present codes (in $line) and try to replace them.
hth,
dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: RREAD CONSECUTIVE LINES
Luba Pardo am Freitag, 20. Oktober 2006 14:16:
Dear all,
Hello
I am trying to write a script that reads in two or three consecutive lines
to process those. For example that if the first line of file_1 match with
an scalar from a file_2, then print the lines 2 and 3 of the file_1. I
tried to save everything in a array, but the file is extremely large and it
kicks me out.
So, I have tried to work line by line:
You miss
use strict;
use warnings;
and the handling of the errors/warnings that would show up (declare variables
with my etc.).
Without these, its very easy to write messy code that won't do what you want.
open (READER_1,out) || die \n I can't open the file READER_1 !!\n;
open (READER_2,out.txt) || die \n I can't open the file READER_2 !!\n;
Include $! in the die string to get the reason when open failes.
@a1= READER_2;
The contents of @a1 are never used, only its size.
close (READER_2);
@arr=();
Never used.
for ($i=0; $i=$#a1;$i=$i+1 ) {
Not clear to me what you want in this for loop:
$l= READER_1;
$l contains one line from READER_1.
@temp1=split/[]/,$l[$i];
There is no array @l that could be accessed with $l[$i].
@temp2=split/[]/,$l[$i+1];
@temp3=split/[]/,$l[$i+2];
@temp4=split/[]/,$l[$i+3];
print @temp1 is temp1\n;
}
BUT I DO NOT GET ANYTHING. I wonder if there is another way to work it out.
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: read consecutive lines
Luba Pardo [offlist]:
D. Bolliger am Freitag, 20. Oktober 2006 15:00:
Luba Pardo am Freitag, 20. Oktober 2006 14:16:
Dear all,
Hello
I am trying to write a script that reads in two or three consecutive
lines to process those. For example that if the first line of file_1
match with an scalar from a file_2, then print the lines 2 and 3 of the
file_1. I tried to save everything in a array, but the file is
extremely large and it kicks me out.
So, I have tried to work line by line:
You miss
use strict;
use warnings;
and the handling of the errors/warnings that would show up (declare
variables with my etc.).
Without these, its very easy to write messy code that won't do what you
want.
open (READER_1,out) || die \n I can't open the file READER_1
!!\n; open (READER_2,out.txt) || die \n I can't open the file
READER_2 !!\n;
Include $! in the die string to get the reason when open failes.
@a1= READER_2;
The contents of @a1 are never used, only its size.
close (READER_2);
@arr=();
Never used.
for ($i=0; $i=$#a1;$i=$i+1 ) {
Not clear to me what you want in this for loop:
$l= READER_1;
$l contains one line from READER_1.
@temp1=split/[]/,$l[$i];
There is no array @l that could be accessed with $l[$i].
@temp2=split/[]/,$l[$i+1];
@temp3=split/[]/,$l[$i+2];
@temp4=split/[]/,$l[$i+3];
print @temp1 is temp1\n;
}
BUT I DO NOT GET ANYTHING. I wonder if there is another way to work it
out.
Dani
Hello
Please answer to the list.
As I mentioned before I am trying to match the information of two files
simultaneously. Then @a1 is file_2 (that have to be evaluated), but I did
not included as I am getting trouble to process file_1 (READER_1) because
is too big.
I tried to process this file by saving as an array as I did with READER_2,
bit it did not work. So I tried to read every three lines...
Below READER_2 is used, not READER_1.
I used
$I=0;
Variable names are case sensitive. You use two variables $I and $i. Read
perldoc perldata
for information about variables.
while ($line=READER_2) {
$line is a scalar variable (containing one line), not an array (would be
@line), so you can't access $line[$i].
@temp2=split/[]/,$line[$i];
@temp3=split/[]/,$line[$i+1];
@temp4=split/[]/,$line[$i+2];
$I++;
}
but it did not work either. So I though of making a loop and process line
by line.
Remember to put
use strict;
use warnings;
at the top of the code and declare your variables with my (perldoc -f my)
Anyway, you got all lines into an array by
my @lines=READER_2;
Below is a sample code that loops through a file by reading 3 lines at a time
(it's very unelegant, I seem to have a blackout, so look out for other
answers).
It checks if the input file has the right amount of lines (multiple of 3).
At the end of the loop, you have 3 lines in @lines3 that you can use for
further processing with data from READER_2.
#!/usr/bin/perl
use strict;
use warnings;
while (1) { # unelegant way to handle 3 lines of big file at a time
my @lines3=();
defined ($lines3[0]=DATA) or last; # stop if no more lines
defined ($lines3[1]=DATA) or die '# of lines not a multiple of 3';
defined ($lines3[2]=DATA) or die '# of lines not a multiple of 3';
# demonstration how to access one of the three lines:
#
warn 1/3: $lines3[0], 2/3: $lines3[1], 3/3: $lines3[2];
}
__DATA__
line1
line2
line3
line4
line5
line6
line7 gives error
Hope this helps to get a new version of your code.
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: How to load text into Curses::UI::TextEditor - -text?
ert weerr am Montag, 9. Oktober 2006 09:24:
Guys,
Hello
I'd like to write a perl-based tool that helps me to
do my regular system monitoring tasks.
It would be running in console mode but using
'windows' to list the command outputs.
Curses::UI::TextEditor would be one of the elements
that I use to present the output in a nice formatted
way.
It appears to me that its -text option is not
accepting strings from a function but only static
texts.
Is there anyone here who already had to struggle with
this module before?
Sorry if it's an off-topic email here, I really don't
know where to ask my question.
Thanks in advance!
Regards,
John
Here's an example:
$w{202}-add(
undef, 'TextEditor',
-title = 'Disk space',
-y = 0, -padright = 0, -border = 1,
-padbottom = 0,
-readonly = 1,
-vscrollbar = 1,
-hscrollbar = 1,
-text = $text,
);
The variable $text has only a simple string value
something like This is a test..., but when I run the
code the TextEditor only present '1'.
If I try to use the function like this
-text = \fs_check,
The the result is 'CODE(0x972e3c4)'
You assigned a reference to a subroutine, and it's address is correctly shown,
since the value of this attribute is not called by the code but displayed
literally.
You probably want to assign the result string of a call of the subroutine:
-text = fs_check(),
Does this help?
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: about PXPerl
chen li am Donnerstag, 5. Oktober 2006 14:13: Hi all, I recenlty install PXPerl on my window xp. The documentations come with perl6 bible stuff. Out of curiosity I read some of the object section and data type/variable in Perl 6. It looks like we have to predeclare a lot of types of variables before we can use them, just like those in JAVA. Any comments? Sounds like a good feature :-) Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: sorting DBM hash
John W. Burns am Donnerstag, 28. September 2006 17:11:
Sorting DBM Hash
Greetings:
Hello John W.
I've run into what appears to be a conflict in sorting
a DBM Hash. The DBM is opened and closed through tie and untie to store
selections
from Perl Tk medical questionnaire which uses checkboxes, radio buttons and
lists, and contains over 200 items. I'm attempting to verify that all user
selections are accurately stored in the DB.
The first sort routine prints out keys and value. However it fails to
include
some keys such as variable ckb_100 or ckb_104 (or their values) along with
a few other variables.
When I use Randal Schwartz's sort from Learning Perl, it (by design) lists
keys sorted by value order (without listing values), but includes all keys
in the
DB including those keys dropped in the first sort. I have reviewed the
PerlTk program a number of times and can't find an error (realize
this doesn't mean there isn't one). But why would Randal's sort contain a
key that is not included in the other sort? Randal's sort indicates all
user selections are included in DB; other sort does not.
Here's the first sort code on the DBM Hash; it fails to list all keys and
their values.
#!/usr/local/bin/perl
use warnings;
use strict;
use SDBM_File; #load database module which is a clone of DBM provided by
ACTIVE STATE
$db = c:/temp/userstats.db; #where data is kept between runs
dbmopen(%DATA, $db, 0666 ) or die( Can't open: $! );
foreach my $key ( sort { $a = $b } keys %DATA ) {
Try to replace the numerical comparison '=' with the alphanumerical 'cmp'
one, since your keys are alphanumerical.
Didn't you get a warning of the sort
Argument ckb_100 isn't numeric in sort at -e line x.?
print $key = $DATA{$key}\n;
}
Here's Randal Schwartz', Learning Perl,sort; it lists all keys.
#!/usr/local/bin/perl
use warnings;
use SDBM_File; #load database module which is a clone of DBM provided by
ACTIVE STATE
$db = c:/temp/userstats.db;#where data is kept between runs
dbmopen(%DATA, $db, 0666 ) or die( Can't open: $! );
my @choices = sort by_score_and_name keys %DATA;
sub by_score_and_name {
$DATA{$b} = $DATA{$a} #by descending numeric score
or
$a cmp $b #ASCIIbetically by name
^
hint
}
print @choices, \n;
dbmclose(%DATA);
Here's a typical PerlTk GUI:
#Post Traumatic Stress Disorder
$ckb_100 = $frme_name1a - Checkbutton(-text=post traumatic stress
disorder, -variable=\$post2,
-command =\variable_100);
$ckb_100- deselect();
$ckb_100- form(-left=460, -top=585);
An anonymous sub routine is used to hold sub routines
for all the question variables. Here's a standard sub for
checkbox.
sub variable_100 {
my $x = ${$ckb_100 -cget(-variable)};
if ($x == 1) {
$DATA{ckb_100} = 1;
}
else {
}
}
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Hash problem
Johnson, Reginald (GTI) am Donnerstag, 28. September 2006 21:58:
I am doing an example from Perl Objects, References modules. I suspect
many of you already use this book as a reference.
My hash is showing the address instead of the name and I'm not sure
why. Here is my output.
this is person=HASH(0x20040014)
this is who=HASH(0x20040014)
HASH(0x20040014) is missing preserver
HASH(0x20040014) is missing sunscreen
HASH(0x20040014) is missing water_bottle
HASH(0x20040014) is missing jacket
Here is the code
#!/usr/bin/perl
use strict;
my @gilligan = qw(red_shirt hat lucky_socks water_bottle);
my @skipper = qw ( blue_shirt hat preserver sunscreen);
my @professor = qw(sunscreen water_bottle slide_rule batteries
radio);
my %all = {
usage of '()' instead of '{}' would probably help :-)
The hash as defined in your line has one key with a stringified address, and
the value is undef.
Check this out with
use Data::Dumper;
warn Data::Dumper::Dumper (\%all);
Gilligan = [EMAIL PROTECTED],
Skipper = [EMAIL PROTECTED],
Professor = [EMAIL PROTECTED],
};
check_items_for_all(\%all);
sub check_items_for_all{
my $all = shift;
for my $person(sort keys %$all) {
print this is person=$person\n;
check_items_required($person, $all-{$person});
} #end for
} #end check_items_for_all
sub check_items_required {
my $who = shift;
print this is who=$who\n;
my $items = shift;
my @required = qw(preserver sunscreen water_bottle
jacket);
for my $item (@required) {
unless (grep $item eq $_, @$items) { #if
statement is false
print $who is missing $item\n;
} #end unless
} #end for
} #end sub
Hope this helps!
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: interpoliation within regexp
Derek B. Smith am Donnerstag, 28. September 2006 22:28: Why not just specify a non-digit for the first character: my @a = ( 0 .. 9, 'a' .. 'z', 'A' .. 'Z'); my $password = join '', $a[ 10 + rand( @a - 10 ) ], map $a[ rand @a ], 1 .. 5; John Ok great, but I do not fully understand this. Will you explain in English? Join with '': a) a randomly selected entry from @a excluding the digits at positions 0..9 [the part between the 1st and 2nd comma] b) five randomly selected entries from @a [the map part] Note: @a is used in scalar context both times, meaning the number of entries in @a. perldoc -f map perldoc -f join perldoc -f rand My tip for cases where you get a working solution you don't understand fully: a) Try to find out what belongs together (imagine '()'s) b) Try to break the solution apart according to the findings in a) c) examine the parts: print them out, dump them with Data::Dumper, modify them, read the man pages d) put them together again, eventually one by one part, using examination techniques as in c) Hope this helps! Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Hash problem
Johnson, Reginald (GTI) am Donnerstag, 28. September 2006 22:56: I guess it is a good practice to use data::dumper when you are developing programs. What you should always use is (as others pointed out) the lines: use strict; use warnings; to improve detection of errors. Data::Dumper is useful if you are not shure how a data structure looks like ( hm, that should not occur in own programs ;-) ), or to check if it really looks as expected. And of course creating test scripts is always a good thing to answer the question: Does my program what it should do? See for example: Test::Simple Test::More When I search CPAN in modules I see a quick snopsis of data dumper. Is there an area in CPAN that has a more verbose listing of modules? I'm not sure what you mean here. You can use search.cpan.org to search modules, and after a click on the module name, the manual is displayed. Via this page you can (directly) reach the source code, and (indirectly) all files in the distribution, including the test scripts. regards Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: perl scalar
[rearranged to bottom posting style] Marc Sacks am Dienstag, 26. September 2006 14:25: D. Bolliger wrote: elite elite am Montag, 25. September 2006 22:27: I not sure what i doing wroung. I'm not sure either :-) Street=Wright; This is wrong syntax; Street is not a scalar variable, while $street would be. print $street\n; $street is undef here, you didn't assign anything to the $street variable. $street=Washington; That's ok, but never used. And i get this output. Street/[EMAIL PROTECTED] ~]$ Weird, I can't explain that. Your code (is it a snippet from the actual code?) does not even compile on my box and (correctly) emits the error: Can't modify constant item in scalar assignment at - line 1, near Wright; Execution of - aborted due to compilation errors. - How exactly did you invoke your code? - What is output if you run the code: #!/usr/bin/perl use strict; use warnings; my $street='Wright'; # ok, why not :-) print $street\n; $street='Washington'; print $street\n; __END__ ? Dani Hello Marc Odd. I just tried the same code snippet and it worked fine. Do you refer to the original code? #!/usr/bin/perl Street=Wright; print $street\n; $street=Washington; This would be very odd?!? You might try putting a space before and after your = signs. Yes, many people consider this better formatting style... I don't know if that makes a difference, but it won't hurt. ... but it won't change the interpretation of the code by perl :-) Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: backreference in regexp
chen li am Dienstag, 26. September 2006 15:52:
Hi all,
Hi chen
I see some codes as following
my $regexp= (([gatc]{3})\\2{3,});
Single quotes would make the double slash unnecessary:
my $regexp= '(([gatc]{3})\2{3,})';
[...]
What is the meaning of {3,} of in \2{3,} ?
I know \2 is a backreference here but not sure {3,}.
I check the camel book and some perldoc but I can't
find answer.
Check perldoc perlre, Regular Expressions:
The following standard quantifiers are recognized:
[...]
{n}Match exactly n times
{n,} Match at least n times
{n,m} Match at least n but not more than m times
\2{3,} in your regexp means that what [gatc]{3} matched should at least
match three times.
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Standard input errors
elite elite am Dienstag, 26. September 2006 20:16: Here are my error: Instead of the line use warnings; you can use use diagnostics; which gives you a more verbose explanation of errors! The documentation for both you can get by (from the cmdline prompt): perldoc warnings; perldoc diagnostics; (after perldoc you can put anything that you use after a use ... line. [EMAIL PROTECTED] ~]$ perl hello.pl String found where operator expected at hello.pl line 15, near print (Might be a runaway multi-line string starting on line 11) (Missing semicolon on previous line?) Backslash found where operator expected at hello.pl line 15, near print \ (Do you need to predeclare print?) Backslash found where operator expected at hello.pl line 15, near address\ String found where operator expected at hello.pl line 15, at end of line (Missing semicolon on previous line?) syntax error at hello.pl line 15, near print Global symbol $address requires explicit package This error is a result of the use strict; line in your program. But *don't* eliminate it from the script, it forces you to declare all variables that you use. Most of the time, a variable is declared with a my preceeding the variable at the point it is introduced (mentioned the first time). name at hello.pl line 11. Global symbol $name requires explicit package name at hello.pl line 11. Can't find string terminator '' anywhere before EOF at hello.pl line 15. Sometimes the error *is* not at the line mentioned in the error message; it tells you at which line perl has *detected* the error, this may be some or even many lines below :-) Go trough the error messages from top to bottom, and correct the errors from top to bottom (not the other way round - generally). here my code.I not sure what i did wroung here. #!/usr/bin/perl use strict; use warnings; my $street='Wright'; print $street\n; $street='Washington'; print $street\n; print One major street in madison is Washington\n; or, since you created a variable for the street: print One major street in madison is '$street'\n; (I'm not from there, but isn't there a Madison street in Washington? ;-) print enter your address/n; my $address $name =; The above lines are a bit messy, arne't they? You ask for the address and save it in a variable which most people expect to contain a name... print \nPerl has received your address\n; Give a feedback: print \nPerl has received your address:\n$address; :-) Dani -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: incorrect output
Geetha Weerasooriya am Mittwoch, 27. September 2006 05:58:
Hi dear all,
Hi Geetha
We (at least I) have to guess the things you don't describe.
And there is no test data to reproduce the wrong output.
I have written a script which reads the data lines and when a blank line
is found all the data up to the previous line is considered as a one set
and new set is started after the next line. Then I subtracted from one
element of the last line of that set the same element of the first line
of data. When I run this program, the trajectory travel time calculated
is correct only for the first 3 trajectories and there after it is
wrong.
What was wrong?
I can't understand why it gives correct value for first three
trajectories. Can someone please help me??
My data file looks like follows:
5/1/2004
07:06:43
10
139.6668
35.52782
21.2
32952056
5593
0.86
25603
3
I guess your data for one record is on a single line, delimited with commas,
right?
The script is as follows:
#!perl/bin/perl ;
use strict;
#use warnings;
my $i;
my $j;
my $data;
my @line;
my @time_in_seconds;
Possibly this variable is the source of the miscalculation.
It is never reset, but you use it with $time_in_seconds[-1] in the code
(deliver the last entry of the array), and at some points the array could
have more elements (from a passed trajectory) than you expect and are
correct.
The deeper reason for this is that you declare your variables not at the
appropriate places. You should declare them in the minimal possible scope
where used, and (re)initialize them at the appropriate place.
my $travel_time;
my $trajectory_travel_time;
my @vid;
open (FILE, data.csv ) || die can't open the file;
open (OUT1, travel_time.csv) || die can't open the file;
open (OUT2, trajectory.csv) || die can't open the file;
$i = 0;
$j=1;
while (FILE) {
$i++;
$data = $_;
$data is never used.
chomp;
@line=split /,/;
$vid[$i] = $line[2];
if (@line != ()) {
if (@line) {
avoids the warning.
$time_in_seconds[$i] = $line[-2];
if ( $i==1) {
$travel_time= 0;
} else {
$travel_time = $time_in_seconds[$i] - $time_in_seconds[1];
}
print OUT1 $_,$travel_time \n;
} else {
$trajectory_travel_time = $time_in_seconds[-1] -
$time_in_seconds[1];
Here is maybe the miscalculation ($time_in_seconds[-1]).
Has the array as many elements as you expect?
(btw while answering this question you will see why it is mostly advisable to
base indexes on 0 and not 1).
print OUT2 $vid[$i-1],Trajectory$j, $trajectory_travel_time
\n;
$j++;
$i=0;
print OUT1 \n;
}
}
*If* I did not guess the error source, you can put test data that reproduces
the wrong output as follows:
1. Put at the end of the script the test data, something like:
__DATA__
5/1/2004,07:06:43,10,139.6668,35.52782,21.2,32952056,5593,0.186,125603,3
5/1/2004,07:06:43,10,139.6668,35.52782,21.2,32952056,5593,0.986,925622,3
5/1/2004,07:06:43,10,139.6668,35.52782,21.2,32952056,5593,0.86,25603,3
5/1/2004,07:06:43,10,139.6668,35.52782,21.2,32952056,5593,0.186,125603,3
5/1/2004,07:06:43,10,139.6668,35.52782,21.2,32952056,5593,0.286,225603,3
5/1/2004,07:06:43,10,139.6668,35.52782,21.2,32952056,5593,0.386,325603,3
5/1/2004,07:06:43,10,139.6668,35.52782,21.2,32952056,5593,0.486,425603,3
2a. Comment out the open (FILE line)
2b. replace the line while (FILE) {
with while (DATA) {
When I turn on the use warnings it gives the warning ' Use of
uninitialized value in numeric ne(!=) at . line 37, FILE line..
Here line 37 is if (@line != ()) {
(see comment in the code)
regards
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Proper output
Sayed, Irfan (Irfan) am Montag, 25. September 2006 14:50:
Can any body please help on this
Regards
Irfan.
Hello
please read on at the bottom.
_
From: Sayed, Irfan (Irfan)
Sent: Friday, September 22, 2006 12:59 PM
To: beginners@perl.org
Subject: Proper output
Hi All,
I am not getting the proper output in @vob_rep Array.
Following is my code
# Perl script to change the replica name
use strict;
use warnings;
my $fname = /tmp/vob_list1;
open FILE,,$fname or die $!;
my $fname1 = /tmp/repl_list1;
open FILE1,,$fname1 or die $!;
my $CT = '/usr/atria/bin/cleartool';
my $MT = '/usr/atria/bin/multitool';
my @vob_list = `$CT lsvob -s`;
print FILE @vob_list;
my @repl;
my @repl1;
foreach my $a (@vob_list)
{
@repl = `$CT lsreplica -s -invob $a`;
@repl1 = grep { /cmvobsvr1mum/i } @repl; print FILE1 @repl1; } my
@vob_rep = splice(@repl1, 0, -10); print @vob_rep;
close FILE1;
Plz help
Regards
Irfan.
Please don't top post. The answer follows the question, that's the natural
order.
Did you read John W. Krahn's hints?
Please, if you expect help from people that can't read minds:
Describe your problem. What means proper output? What should be the output?
What improper output did you get?
Your script uses external programs that not everybody has installed (I think)
or even has heard of (at least me). This makes it difficult/impossible to
test your script.
It's not clear if that what goes wrong is on the external programs or the perl
level.
Please try to narrow down the place(s) where the misfunction may occur. Did
you insert some simple debug statements as for example warn calls to see if
the output is as you expect? Can you identify lines where something goes
wrong?
If you try to answer such questions, you may find the misfunction yourself. If
not, it makes you able to shorten the scripts to the relevant parts.
patient: I'm feeling ill. What should I do?
doctor : Where do you feel ill?
patient: (silence)
doctor : (waiting)
patient: Please, can you help? I'm feeling ill!
doctor : Next patient please!
Dani
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
