[22814] in Perl-Users-Digest
Perl-Users Digest, Issue: 5035 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat May 24 18:05:56 2003
Date: Sat, 24 May 2003 15:05:11 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sat, 24 May 2003 Volume: 10 Number: 5035
Today's topics:
ANNOUNCE: Device::Modem 1.28 cosimo@streppone.it
ANNOUNCE: Getopt::Long 2.33 (Johan Vromans)
Re: counter (Tad McClellan)
Re: Help with my game (Jay Tilton)
Re: Help with my game <mail@annuna.com>
Re: Help with my game <mail@annuna.com>
Re: Help!: Problem Passing Values to ::Graph (Think its (entropy123)
Re: incorrect "uninitialised value" error in array <abigail@abigail.nl>
merge (concatenate) mp3 files at frame level <pierremart@hotmail.com>
Problem in extracting a string from a file... :-( <bouchon@alussinan.org>
Re: Problem in extracting a string from a file... :-( <uri@stemsystems.com>
Recursive Matching Using foreach (rusneht)
Re: Recursive Matching Using foreach <noreply@gunnar.cc>
Re: Recursive Matching Using foreach (Tad McClellan)
untie of hash fails to work (Brad Lanam)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 20 May 2003 20:07:44 GMT
From: cosimo@streppone.it
Subject: ANNOUNCE: Device::Modem 1.28
Message-Id: <h9o4q-9t7.ln1@red.stonehenge.com>
*** post for FREE via your newsreader at post.newsfeed.com ***
Device::Modem is a perl extension to talk to AT compliant devices via
serial port.
It should be enough platform independent as you need.
Changes
-------------
1.25
1.26
1.27
1.28 Sun May 18 17:19:23 CET 2003
- dial() now works as expected, returning the `CONNECT' or `BUSY'
or whatever message without hanging for minutes;
- answer() routine now is definitely more reliable than before:
now everytime the buffer receives input from modem, it does
not restart counting the timeout. Removed also the possibility
of infinite loop if modem always receives garbage chars (like
on a RAW PPP link);
- Added full documentation for every method;
- Added a FAQ document in new "docs/" folder;
- new(): added possibility to pass a custom log object as `log'
property;
- fixed log levels for File and Syslog plugins. Implemented
correct log level masking also for Syslog.
Prerequisites
-------------
+ working perl installation >= 5.005_03
+ Device::SerialPort 0.19
+ a modem or AT-compliant device if you want to use
it for some real work
-----= Posted via Newsfeed.Com, Uncensored Usenet News =-----
http://www.newsfeed.com - The #1 Newsgroup Service in the World!
-----== 100,000 Groups! - 19 Servers! - Unlimited Download! =-----
------------------------------
Date: 20 May 2003 10:39:12 +0200
From: jvromans@squirrel.nl (Johan Vromans)
Subject: ANNOUNCE: Getopt::Long 2.33
Message-Id: <p9o4q-eck.ln1@red.stonehenge.com>
*** post for FREE via your newsreader at post.newsfeed.com ***
Version 2.33 of module Getopt::Long has been released to CPAN. It will
be standard part of Perl 5.8.1 and 5.9.
Module Getopt::Long implements an extended getopt function called
GetOptions(). This function implements the POSIX standard for command
line options, with GNU extensions, while still capable of handling
the traditional one-letter options (including option bundling).
It adds a lot of features like automatic abbreviation of option names,
aliases and callback functions.
The README document is attached to this message.
The easiest way to get it is by using the CPAN shell:
perl -MCPAN -e 'install("Getopt::Long")'
Alternatively, use a Web browser and point it to the CPAN search engine:
http://search.cpan.org/search?module=Getopt::Long
Changes in this version
-----------------------
**************** WARNING -- EXPERIMENTAL CODE AHEAD ****************
The following new features are marked experimental. This means that if
you are going to use them you _must_ watch out for the next release of
Getopt::Long to see if the API has changed.
* Getopt::Long can automatically handle --version and --help options
if the calling program did not specify a handler explicitly.
Two configuration parameters have been added: 'auto_help' (or
'help') and 'auto_version' (or 'version'). If set, Getopt::Long will
itself take care of --help and --version options. Otherwise,
everything is exactly as it was before.
The new features will be enabled by default for programs that
explicitly require version 2.3203 or later.
Getopt::Long uses module Pod::Usage to produce the help message from
the SYNOPSIS section of the program's POD.
Using a --help (or -?) command line option will write the SYNOPSIS
section of the program's POD to STDOUT, and exit with status 0.
However, an illegal option will produce the help text to STDERR,
and exit with status 2. This is in accordance with current
conventions.
* Two subroutines can be exported on demand:
- VersionMessage
This subroutine prints the standard version message.
- HelpMessage
This subroutine prints the standard help message.
Both subroutines take the same arguments as Pod::Usage::pod2usage,
see its documentation for details.
Example:
use Getopt::Long 2.33 qw(GetOptions HelpMessage);
GetOptions(...) or HelpMessage(2);
**************** END EXPERIMENTAL CODE ****************
* Subroutine Configure can now be exported on demand.
* Negatable options (with "!") now also support the "no-" prefix.
On request of Ed Avis.
* Some fixes with hashes and bundling.
Thanks to Anders Johnson and Andrei Gnepp.
Mandatory/optional status for hash values is now effective.
String valued options with no value now default to the empty string
instead of 1 (one).
NOTE: The hash options still remain more or less experimental.
* Fix a pass_through bug where the options terminator (normally "--")
was not passed through in @ARGV.
Thanks to Philippe Verdret.
* Add FAQ: I "use GetOpt::Long;" (Windows) and now it doesn't work.
Previous released version was 2.32.
---- README ----
Module Getopt::Long - extended processing of command line options
=================================================================
Module Getopt::Long implements an extended getopt function called
GetOptions(). This function implements the POSIX standard for command
line options, with GNU extensions, while still capable of handling
the traditional one-letter options.
In general, this means that command line options can have long names
instead of single letters, and are introduced with a double dash `--'.
Optionally, Getopt::Long can support the traditional bundling of
single-letter command line options.
Getopt::Long::GetOptions() is part of the Perl 5 distribution. It is
the successor of newgetopt.pl that came with Perl 4. It is fully
upward compatible. In fact, the Perl 5 version of newgetopt.pl is just
a wrapper around the module.
For complete documentation, see the Getopt::Long POD document or use
the command
perldoc Getopt::Long
FEATURES
========
* Long option names
Major advantage of using long option names is that it is much easier
to memorize the option names. Using single-letter names one quickly
runs into the problem that there is no logical relationship between
the semantics of the selected option and its option letter.
Disadvantage is that it requires more typing. Getopt::Long provides
for option name abbreviation, so option names may be abbreviated to
uniqueness. Also, modern shells like Cornell's tcsh support option
name completion. As a rule of thumb, you can use abbreviations freely
while running commands interactively but always use the full names in
scripts.
Examples (POSIX):
--long --width=80 --height=24
Extensions:
-long (convenience) +width=80 (deprecated) -height 24 (traditional)
By default, long option names are case insensitive.
* Single-letter options and bundling
When single-letter options are requested, Getopt::Long allows the
option names to be bundled, e.g. "-abc" is equivalent to "-a -b -c".
In this case, long option names must be introduced with the POSIX "--"
introducer.
Examples:
-lgAd (bundle) -xw 80 (bundle, w takes a value) -xw80 (same)
even -l24w80 (l = 24 and w = 80)
By default, single-letter option names are case sensitive.
* Flexibility:
- options can have alternative names, using an alternative name
will behave as if the primary name was used;
- options can be negatable, e.g. "debug" will switch it on, while
"nodebug" will switch it off.
- options can set values, but also add values producing an array
of values instead of a single scalar value, or set values in a hash.
* Options linkage
Using Getopt::Long gives the programmer ultimate control over the
command line options and how they must be handled:
- by setting a global variable in the calling program;
- by setting a specified variable;
- by entering the option name and the value in an associative array
(hash) or object (if it is a blessed hash);
- by calling a user-specified subroutine with the option name and
the value as arguments (for hash options: the name, key and value);
- combinations of the above.
* Customization:
The module can be customized by specifying settings in the 'use'
directive, or by calling a special method, Getopt::Long::Configure.
For example, the following two cases are functionally equal:
use Getopt::Long qw(:config bundling no_ignore_case);
and
use Getopt::Long;
Getopt::Long::Configure qw(bundling no_ignore_case);
Some of the possible customizations. Most of them take a "no_" prefix
to reverse the effect:
- default
Restore default settings.
- auto_abbrev
Allow option names to be abbreviated to uniqueness.
- getopt_compat
Allow '+' to start options.
- gnu_compat
Compatibility with GNU getopt_long().
- permute
- require_order
Whether non-options are allowed to be mixed with options.
permute means that
-foo arg1 -bar arg2 arg3
is equivalent to
-foo -bar arg1 arg2 arg3
(provided -foo does not take an argument value).
require_order means that options processing
terminates when the first non-option is encountered.
-foo arg1 -bar arg2 arg3
is equivalent to
-foo -- arg1 -bar arg2 arg3
- bundling
Setting this variable to a non-zero value will allow
single-character options to be bundled. To distinguish bundles
from long option names, long options must be introduced with
"--" and single-character options (and bundles) with "-".
- ignore_case
Ignore case when matching options.
- pass_through
Do not issue error messages for unknown options, but leave
them (pass-through) in @ARGV.
- prefix
The string that starts options. See also prefix_pattern.
- prefix_pattern
A Perl pattern that identifies the strings that introduce
options. Default is (--|-|\+) unless environment variable
POSIXLY_CORRECT has been set, in which case it is (--|-).
- debug
Enable copious debugging output.
* Object oriented interface:
Using the object oriented interface, multiple parser objects can be
instantiated, each having their own configuration settings:
$p1 = new Getopt::Long::Parser (config => ["bundling"]);
$p2 = new Getopt::Long::Parser (config => ["posix"]);
if ($p1->getoptions(...options descriptions...)) ...
AVAILABILITY
============
The official version for module Getopt::Long comes with the Perl 5
distribution.
Newer versions will be made available on the Comprehensive Perl Archive
Network (CPAN), see "http://www.perl.com/CPAN/authors/Johan_Vromans".
Or use the CPAN search engine:
http://search.cpan.org/search?mode=module&query=Getopt::Long
http://search.cpan.org/search?module=Getopt::Long
COPYRIGHT AND DISCLAIMER
========================
Module Getopt::Long is Copyright 2003,1990 by Johan Vromans.
This program is free software; you can redistribute it and/or
modify it under the terms of the Perl Artistic License or the
GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any
later version.
-------------------------------------------------------------------
Johan Vromans jvromans@squirrel.nl
Squirrel Consultancy Haarlem, the Netherlands
http://www.squirrel.nl http://www.squirrel.nl/people/jvromans
------------------ "Arms are made for hugging" --------------------
-----= Posted via Newsfeed.Com, Uncensored Usenet News =-----
http://www.newsfeed.com - The #1 Newsgroup Service in the World!
-----== 100,000 Groups! - 19 Servers! - Unlimited Download! =-----
------------------------------
Date: Sat, 24 May 2003 09:45:34 -0500
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: counter
Message-Id: <slrnbcv1ce.3s1.tadmc@magna.augustmail.com>
Andras Malatinszky <nobody@dev.null> wrote:
> Brian H¹© wrote:
>> open( F, $ARGV[0] );
>
>
> Don't do that! Don't blindly open files without checking to make sure
> it's OK. Suppose you have the code above in program.pl, and then someone
> comes along and types
>
> perl program.pl >/data/irreplaceable/precious.dat
>
> Ouch!
That will hurt whether you change the Perl code or not...
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Sat, 24 May 2003 16:49:03 GMT
From: tiltonj@erols.com (Jay Tilton)
Subject: Re: Help with my game
Message-Id: <3ecfa200.349358853@news.erols.com>
Joe Creaney <mail@annuna.com> wrote:
: It is rpg 1.2 beta. My problem is that I put weapons and armor which
: are objects in a another object player and when I try to print them out
: they don't show up.
Bummer.
: The equipment that starts with the player will
: print out. I am really stumped. The program is pretty long about 700
: lines long. I hope on you gurus out there can explain to me what the
: problem is and if I can fix it.
A tester would have to witness the misbehavior first. As is, the only
apparent way to do that is to muddle through running the program,
wondering at each step "is that what he's talking about?"
It would be nice if the program had a throwaway section of code that
automatically simulated the problem, e.g.
sub bug_demonstration {
print "Simulating inventory bug\n";
print "Initial inventory:\n";
# call code that displays possessions
print "Adding another object to inventory\n";
# call code that adds another possession
print "New inventory:\n";
# display possessions again
print "Where did it go?\n"
exit;
}
: I think the game is pretty cool for a self taught amateur programmer.
What's cool is that you have given yourself a project you can get
excited about, and that excitement is pushing you to learn.
------------------------------
Date: Sat, 24 May 2003 12:50:00 -0500
From: Joe Creaney <mail@annuna.com>
Subject: Re: Help with my game
Message-Id: <3ECFB0C8.8060800@annuna.com>
Jay Tilton wrote:
> Joe Creaney <mail@annuna.com> wrote:
>
> : It is rpg 1.2 beta. My problem is that I put weapons and armor which
> : are objects in a another object player and when I try to print them out
> : they don't show up.
>
> Bummer.
>
> : The equipment that starts with the player will
> : print out. I am really stumped. The program is pretty long about 700
> : lines long. I hope on you gurus out there can explain to me what the
> : problem is and if I can fix it.
>
> A tester would have to witness the misbehavior first. As is, the only
> apparent way to do that is to muddle through running the program,
> wondering at each step "is that what he's talking about?"
>
> It would be nice if the program had a throwaway section of code that
> automatically simulated the problem, e.g.
>
> sub bug_demonstration {
> print "Simulating inventory bug\n";
> print "Initial inventory:\n";
> # call code that displays possessions
> print "Adding another object to inventory\n";
> # call code that adds another possession
> print "New inventory:\n";
> # display possessions again
> print "Where did it go?\n"
> exit;
> }
>
> : I think the game is pretty cool for a self taught amateur programmer.
>
> What's cool is that you have given yourself a project you can get
> excited about, and that excitement is pushing you to learn.
>
Thank you for your response. What you say is true. I will try to put
the error function in it. That will be a challenge. I think once I
have the bugs out this system has potential to be expanded into an
interesting game. Yes I am learning allot.
------------------------------
Date: Sat, 24 May 2003 13:20:49 -0500
From: Joe Creaney <mail@annuna.com>
Subject: Re: Help with my game
Message-Id: <3ECFB801.7090802@annuna.com>
Jay Tilton wrote:
> Joe Creaney <mail@annuna.com> wrote:
>
> : It is rpg 1.2 beta. My problem is that I put weapons and armor which
> : are objects in a another object player and when I try to print them out
> : they don't show up.
>
> Bummer.
>
> : The equipment that starts with the player will
> : print out. I am really stumped. The program is pretty long about 700
> : lines long. I hope on you gurus out there can explain to me what the
> : problem is and if I can fix it.
>
> A tester would have to witness the misbehavior first. As is, the only
> apparent way to do that is to muddle through running the program,
> wondering at each step "is that what he's talking about?"
>
> It would be nice if the program had a throwaway section of code that
> automatically simulated the problem, e.g.
>
> sub bug_demonstration {
> print "Simulating inventory bug\n";
> print "Initial inventory:\n";
> # call code that displays possessions
> print "Adding another object to inventory\n";
> # call code that adds another possession
> print "New inventory:\n";
> # display possessions again
> print "Where did it go?\n"
> exit;
> }
>
> : I think the game is pretty cool for a self taught amateur programmer.
>
> What's cool is that you have given yourself a project you can get
> excited about, and that excitement is pushing you to learn.
>
I did that and the error will show up after you choose a name for the
player.
------------------------------
Date: 24 May 2003 11:19:11 -0700
From: email_entropy123@yahoo.com (entropy123)
Subject: Re: Help!: Problem Passing Values to ::Graph (Think its format...)
Message-Id: <90cdce37.0305241019.5c779724@posting.google.com>
Thanks,
That did the trick,
I'm onto a new problem now and I'll put it in a new thread :)
entropy
------------------------------
Date: 24 May 2003 16:13:20 GMT
From: Abigail <abigail@abigail.nl>
Subject: Re: incorrect "uninitialised value" error in array
Message-Id: <slrnbcv6gv.kuj.abigail@alexandra.abigail.nl>
Rene van Leeuwen (r.t.j.van.leeuwenNOSPAM@THANKSplanet.nl) wrote on
MMMDLIII September MCMXCIII in <URL:news:banuiq$b6d$1@reader11.wxs.nl>:
<> In the following code I get the following errors:
<> arr[$k]= 2
<> Use of uninitialized value in numeric lt (<) at ./erathos7.pl line 16.
<> Use of uninitialized value in modulus (%) at ./erathos7.pl line 18.
<> Illegal modulus zero at ./erathos7.pl line 18.
<>
<> As far as I can see both @arr and $j are initialised, also the output
<> for 'arr[$k]= 2' proves that the array is filled. So I think the error is
<> incorrect. Can anyone advise me on this, please?
<> Please do not tell me that I shouldn't use "goto LABEL" I know that, but
<> this code is a test to be as fast (and ugly) as possible to calculate
<> prime-numbers.
That @arr and $j are initialized doesn't mean that $arr [$j] is.
The first time you are getting a problem is when $j equals 2, but
@arr only has 2 elements. So, $arr [2] is "out of bounds", for
which Perl will use an undefined value.
Furthermore, you are using a slow algorithm, using lots of space.
Here's a program that finds primes, which uses not so much memory,
about 1 Mb for every 25 million numbers to be tested.
Abigail
#!/opt/perl/bin/perl -l
# A sieve based on base 6. Only possible primes are those numbers p
# for which p mod 6 == 1, or p mod 6 == 5.
#
# Let n = 6 * k + l (0 <= l < 6). Then the bit b associated with n is
# b = 2 * k + [undef, 0, undef, undef, undef, 1] -> [l]
# In reverse, given a bit b, the corresponding number n is
# n = 6 * int (b / 2) + [1, 5] -> [b % 2].
use strict;
use warnings 'all';
sub scrub ($);
sub findnext ($);
my $max = $ARGV [0] || 1000;
my @PRIMES = (2, 3);
my $BASE = 6; # LCM of @PRIMES.
my $BITS_BASE = 2;
my $BITS_BYTE = 8;
my $bits = $BITS_BASE * int ($max / $BASE) + ($max % $BASE ? $BITS_BASE : 0);
my $bytes = int ($bits / $BITS_BYTE) + ($bits % $BITS_BYTE ? 1 : 0);
my $sieve = eval qq !"\xFF" x $bytes!; # Half the memory usuage.
# Numbers less than the base are special.
foreach my $prime (@PRIMES) {
print $prime
}
my $i = 5;
for (; $i && $i <= sqrt ($max); $i = findnext $i) {
print $i;
scrub $i;
}
for (; $i && $i < $max ; $i = findnext $i) {
print $i;
}
exit;
my ($offset1, $offset2);
INIT {
$offset1 = [undef, 0, undef, undef, undef, 1];
$offset2 = [1, 5];
}
# Scrub out all multiples of the given argument. It's easy to see that
# all multiples less than the square already have been crossed out, and
# we only have to scrub out the odd multiples.
sub scrub ($) {
use integer;
my $n = shift;
my $m = $n;
if ($m % 3 == 1) {
my $c = $n * $m;
vec ($sieve, $BITS_BASE * ($c / $BASE) + $offset1 -> [$c % $BASE],
1) = 0;
$m += 4;
}
my $c = $n * $m;
# $b is the bit index in the sieve, $b1 and $b2 are the increments
# in the loop.
my $b = $BITS_BASE * ($c / $BASE) + $offset1 -> [$c % $BASE];
my $b1 = (2 * $n / ($BASE / $BITS_BASE));
my $b2 = (4 * $n / ($BASE / $BITS_BASE));
# Exactly one of $b1, $b2 needs to be incremented by 1,
# depending on the parity of $c.
($c % 6 == 1 ? $b2 : $b1) += 1;
# Make sure we don't go out of range.
my $l = $bits - $b1 - $b2;
# Core loop, we want to minimize work here.
while ($b <= $l) {
vec ($sieve, $b, 1) = 0; $b += $b1;
vec ($sieve, $b, 1) = 0; $b += $b2;
}
# Basically a copy of the previous loop, but with extra checks.
# Checks don't hurt now as this loop is performed only once.
{
last if $b > $bits;
vec ($sieve, $b, 1) = 0; $b += $b1;
last if $b > $bits;
vec ($sieve, $b, 1) = 0; $b += $b2;
}
}
# Find the next prime number after the given number.
sub findnext ($) {
use integer;
my $n = shift;
my $i = $BITS_BASE * ($n / $BASE) + $offset1 -> [$n % $BASE] + 1;
while ($i <= $bits) {
if (vec ($sieve, $i, 1)) {
return $BASE * ($i / $BITS_BASE) + $offset2 -> [$i % $BITS_BASE]
}
$i ++
} undef;
}
__END__
--
#!/opt/perl/bin/perl -- # Remove trailing newline!
BEGIN{$SIG{__WARN__}=sub{$_=pop;y-_- -;print/".*(.)"/;
truncate$0,-1+-s$0;exec$0;}}//rekcaH_lreP_rehtona_tsuJ
------------------------------
Date: Sun, 25 May 2003 01:54:21 +0800
From: "Pierre Mart" <pierremart@hotmail.com>
Subject: merge (concatenate) mp3 files at frame level
Message-Id: <baobg8$c6l@netnews.hinet.net>
Dear all,
I want to concatenate several mp3 files into one file.
Many resources told me it can be done "at frame level".
That is, we don't need to decode and re-encode them.
We can simply use binary concatenation to do it.
For example, the mp3merge freeware:
http://mp3merge.netfirms.com
I checked. The software just binary concatenates the source files.
What it does is exactly the same as:
(Windows) copy /b file1.mp3+file2.mp3+file3.mp3 output.mp3
or
(Unix) cat file1.mp3 file2.mp3 file3.mp3 > output.mp3
And output.mp3 can be played with mp3 players. Playing is OK.
Good news for me. Thus I can write my own mp3merge with Perl.
However, I encounter one problem:
Correct playing time of output.mp3 cannot be obtained.
(This is important in my application.)
For example, file1.mp3, file2.mp3, file3.mp3 are all 3 seconds.
Both MP3::Info and MS Media Player show output.mp3 is 3 seconds.
But the playing time of output.mp3 is actually 9 seconds.
So is the result of mp3merge (because they are exactly the same.)
I tried MPEG::Audio::Frame like this:
use strict;
use MPEG::Audio::Frame;
local *W;
open W,">output.mp3" or die;
binmode(W);
local *F;
open F,"file1.mp3" or die;
while(my $frame = MPEG::Audio::Frame->read(\*F)) {
print W $frame->asbin;
}
close F;
open F,"file2.mp3" or die;
while(my $frame = MPEG::Audio::Frame->read(\*F)) {
print W $frame->asbin;
}
close F;
open F,"file3.mp3" or die;
while(my $frame = MPEG::Audio::Frame->read(\*F)) {
print W $frame->asbin;
}
close F;
close W;
The output.mp3 is still shown to be 3 seconds.
Even worse, it can't be played.
Questions: Can "frame level concatenation" be done?
If yes, what correction should I make? Any suggestions?
Thank you in advance.
Pierre Mart
------------------------------
Date: Sat, 24 May 2003 23:34:33 +0200
From: Bruno Baguette <bouchon@alussinan.org>
Subject: Problem in extracting a string from a file... :-(
Message-Id: <pan.2003.05.24.21.34.31.917000@usenet.baguette.net>
Hello,
I'm having problem in the writting of a little script perl that have to
read a text file and to output all the text between two strings.
In other words, I have a (loooong) file that have (without the #######) :
##########
bla bla bla bla bla and bla bla bla
bla bla
blabla but
bla bla bla
<!-- begin content -->The text I want to extract that may be in multi
lines<!-- end content --> this is
again bla bla bla
###########
And I would like the script to return me
The text I want to extract
that may be in
multi
lines
Here's the script that I'm having currently :
#!/usr/bin/perl
$| = 1;
$start = '<!-- begin content -->';
$end = '<!-- end content -->';
while(<STDIN>) {
if($_ =~ /$start/ or $_ =~ /$end/) {
$_ = substr($_, index($_, $start), length($_)); $_ =~ s/$start//;
$record = 1;
if($_ =~ /$end/) {
$record = 0;
$_ = substr($_, 0, index($_, $start) - index($_, $end) + 1);
}
$_ =~ s/$end//;
unless($_ =~ /\n/) { $_ .= "\n" }
print $_;
}
if($record) { print $_ }
}
It seems to find the string, but the output is not correct... Do you have
an idea about the error ?
Note that $start and $end are only existing ONE or ZERO time in the file,
no more...
Thanks really much in advance !
--
----------------------------------------
Bruno Baguette - bouchon@alussinan.org
------------------------------
Date: Sat, 24 May 2003 21:43:06 GMT
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: Problem in extracting a string from a file... :-(
Message-Id: <x7he7kuil1.fsf@mail.sysarch.com>
>>>>> "BB" == Bruno Baguette <bouchon@alussinan.org> writes:
BB> ##########
BB> bla bla bla bla bla and bla bla bla
BB> bla bla
BB> blabla but
BB> bla bla bla
BB> <!-- begin content -->The text I want to extract that may be in multi
BB> lines<!-- end content --> this is
BB> again bla bla bla
BB> ###########
BB> $start = '<!-- begin content -->';
BB> $end = '<!-- end content -->';
for starters look at the scalar range operator .. in perl op.
it can reduce your loop to about 2 lines. more if you need to trim and
clean the output but i would use a regex there.
<untested>
while( <> ) {
my $num = /$start/ .. /$end/ ;
next unless $num ;
$rec .= $_ ;
if ( $num =~ /E/ ) {
$rec =~ /$start(.+?)$end/m ;
print $1 ;
}
}
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
------------------------------
Date: 24 May 2003 10:51:30 -0700
From: ramthen@yahoo.com (rusneht)
Subject: Recursive Matching Using foreach
Message-Id: <ab96940e.0305240951.5e117f95@posting.google.com>
Hi ,
While matching a set of strings stored in an array against user given
variable, I am faced with the situation of exiting script with out
proper error message.
Basically, array containing series of strings is called in forach
loop; in this loop each element of array is matched with user input.
If it matches, I try to call a sub-routine; else match next. After
last match fails to succeed, I should print error message to user. How
can this be done ?
Snippet of code is attached :
@tmpary = qw(el, lad, sjfk1, sifh);
foreach (@tmpary)
{
if ( "$_" ne "$userip" )
{
next ;
}
elsif ("$_" eq "$userip")
{
&sub_call();
}
else
{ ;; }
Thanks
ramthen
------------------------------
Date: Sat, 24 May 2003 20:24:26 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Recursive Matching Using foreach
Message-Id: <baodo2$1qbjj$1@ID-184292.news.dfncis.de>
rusneht wrote:
> Hi ,
> While matching a set of strings stored in an array against user given
> variable, I am faced with the situation of exiting script with out
> proper error message.
>
> Basically, array containing series of strings is called in forach
> loop; in this loop each element of array is matched with user input.
> If it matches, I try to call a sub-routine; else match next. After
> last match fails to succeed, I should print error message to user. How
> can this be done ?
>
> Snippet of code is attached :
>
> @tmpary = qw(el, lad, sjfk1, sifh);
------------------^----^------^
You don't mean to add those commas to a list of words in a qw//
string. Check the docs!
> foreach (@tmpary)
> {
> if ( "$_" ne "$userip" )
-----------^--^----^-------^
Redundant quote characters
> {
> next ;
> }
> elsif ("$_" eq "$userip")
> {
> &sub_call();
---------^
Redundant funny character
> }
> else
> { ;; }
This is one possible solution, assuming that the subroutine 'nomatch'
prints the error message:
my $match = 0;
foreach (@tmpary)
{
if ( $_ eq $userip )
{
sub_call();
$match = 1;
last;
}
}
nomatch() unless $match;
/ Gunnar
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Sat, 24 May 2003 13:55:09 -0500
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: Recursive Matching Using foreach
Message-Id: <slrnbcvg0d.47i.tadmc@magna.augustmail.com>
rusneht <ramthen@yahoo.com> wrote:
> @tmpary = qw(el, lad, sjfk1, sifh);
You should always enable warnings when developing Perl code!
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 24 May 2003 13:52:24 -0700
From: bll+goog@gentoo.com (Brad Lanam)
Subject: untie of hash fails to work
Message-Id: <8e13edee.0305241252.3f1f44b5@posting.google.com>
I have a package implementing a tied hash for session management.
In some instances, I need to force the hash to be destroyed (so that
the data in the hash gets saved to the database) before it
goes out of scope, so I do a:
untie %$r_session;
This works for most cases.
However there are a few routines where this does not work.
The DESTROY() function does not get called, the untie does not return
an error, it's as if the untie was completely ignored.
I checked the reference count for the hash, and it's always 1.
The hash only contains simple strings.
Does anyone have any ideas on how to debug this? Workarounds?
-- Brad
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 5035
***************************************
