[24251] in Perl-Users-Digest
Perl-Users Digest, Issue: 6442 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Apr 21 18:05:59 2004
Date: Wed, 21 Apr 2004 15:05:08 -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 Wed, 21 Apr 2004 Volume: 10 Number: 6442
Today's topics:
Re: .plx <uri.guttman@fmr.com>
Asking for comments on this script <rvf_lists@fastmail.fm>
Re: Asking for comments on this script (Randal L. Schwartz)
Re: Asking for comments on this script <tadmc@augustmail.com>
autobox <bik.mido@tiscalinet.it>
Re: autobox <tassilo.parseval@rwth-aachen.de>
Re: capturing stderr from windows (Brian)
Finding all open filehandles and closing them before ex <vilmos@vilmos.org>
Re: grepping lines above and below a pattern found <dwall@fastmail.fm>
Re: grepping lines above and below a pattern found <krahnj@acm.org>
Re: grepping lines above and below a pattern found <tadmc@augustmail.com>
Re: Match Offset: length($`) <bart.lateur@pandora.be>
Negation of RegEx (Andreas Hochsteger)
Re: Negation of RegEx (Randal L. Schwartz)
Re: Negation of RegEx <emschwar@pobox.com>
Re: Negation of RegEx (Randal L. Schwartz)
Re: One question <bik.mido@tiscalinet.it>
Re: sort numeric lists <ittyspam@yahoo.com>
Re: variable interpolation failed :-( <xx087@freenet.carleton.ca>
Re: variable interpolation failed :-( <fred@no-spam.fr>
Re: variable interpolation failed :-( <fred@no-spam.fr>
Re: variable interpolation failed :-( <xx087@freenet.carleton.ca>
Re: variable interpolation failed :-( <tadmc@augustmail.com>
Re: Writing dupliactes to database file <tore@aursand.no>
Re: Writing dupliactes to database file (Malcolm Dew-Jones)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 21 Apr 2004 13:43:25 -0400
From: Uri Guttman <uri.guttman@fmr.com>
Subject: Re: .plx
Message-Id: <sisc3c6x5irm.fsf@tripoli.fmr.com>
>>>>> "TM" == Tad McClellan <tadmc@augustmail.com> writes:
TM> Robin <robin@infusedlight.net> wrote:
>> actually I know quite a bit about nt servers....
TM> Do you have any bridges for sale?
i do! and there are no trolls hiding underneath. :)
uri
------------------------------
Date: Wed, 21 Apr 2004 14:26:23 -0500
From: Rafael Villarroel Flores <rvf_lists@fastmail.fm>
Subject: Asking for comments on this script
Message-Id: <w0asmex5e00.fsfhello@somewhere.com>
The following script already does what I want it to do, but I would
appreciate if the experts here share any comment they may have that
would help improve my Perl skills
#!/usr/bin/perl
# The purpose of this script is to typeset annotations done by the
# chess program Crafty (ftp://ftp.cis.uab.edu/pub/hyatt/), in LaTeX
# (http://www.latex-project.org/). Crafty already has a command to
# produce LaTeX annotations, but this script gives much prettier
# results!
# It requires the Perl module Chess::PGN::Parse, the non-standard
# LaTeX packages skak, chess-workshop-symbols, wrapfig, fullpage and
# needspace, which are available at CTAN, crafty and latex (of
# course), and the pgn-extract utility.
# To use it: starting with, say, games.pgn, use Crafty's annotate
# feature to get games.pgn.can. Then you will want to preprocess this
# file using pgn-extract
# (ftp://ftp.cs.ukc.ac.uk/pub/djb/Extract/About.html) in order to add
# an ECO (opening classification code) tag to each game and get the
# file back into standard PGN notation. You get then gamesann.pgn. You
# should then delete all instances of the comments of the like of
# {annotating both black and white moves.} {using a scoring margin of
# +0.20 pawns.} {search time limit is 1.00}, since they confuse the
# Chess::PGN::Parse module. Say you have now a file gamesann.pgn, you
# are now ready to apply this script, say 'perl skakify.pl
# gamesann.pgn', to obtain gamesann.pgn.tex which you can now process
# with LaTeX
use warnings;
use strict;
use Chess::PGN::Parse;
my $preamble='\documentclass[twocolumn]{article}
\usepackage[T1]{fontenc}
\usepackage{fullpage,ifthen}
\usepackage{skak,chess-workshop-symbols}
\usepackage{wrapfig,needspace}
\setlength{\columnsep}{7mm}
\setlength{\parindent}{0pt}
\setlength{\intextsep}{0pt}
\makeatletter
\newcommand{\@event}{} \newcommand{\@site}{} \newcommand{\@dategame}{}
\newcommand{\@round}{} \newcommand{\@whiteplayer}{}
\newcommand{\@blackplayer}{} \newcommand{\thisresult}{}
\newcommand{\@eco}{}
\newcommand{\event}[1]{\renewcommand{\@event}{#1}}
\newcommand{\site}[1]{\renewcommand{\@site}{#1}}
\newcommand{\dategame}[1]{\renewcommand{\@dategame}{#1}}
\newcommand{\round}[1]{\renewcommand{\@round}{#1}}
\newcommand{\whiteplayer}[1]{\renewcommand{\@whiteplayer}{#1}}
\newcommand{\blackplayer}[1]{\renewcommand{\@blackplayer}{#1}}
\newcommand{\result}[1]{\renewcommand{\thisresult}{#1}}
\newcommand{\eco}[1]{\renewcommand{\@eco}{#1}}
\setlength{\parindent}{0pt}
\newcounter{gameno}
\setcounter{gameno}{1}
\newcommand{\gameheader}%
{\parbox{\linewidth}{%
\begin{center}
\textbf{\thegameno.}
\end{center}
\begin{flushleft}
$\circ$ \textsc{\@whiteplayer}\par%
$\bullet$ \textsc{\@blackplayer}\par%
\smallskip%
\@event \ifthenelse{\equal{\@round}{}}%
{}{, Round \@round}\hspace{\stretch{1}}\textit{\@eco}\par%
\@site\hspace{\stretch{1}}\@dategame\par
\end{flushleft}
\nopagebreak
}% END PARBOX
\addtocontents{toc}{\thegameno. \@whiteplayer--\@blackplayer\dotfill\thepage\par}
\addtocounter{gameno}{1}
\renewcommand{\@event}{} \renewcommand{\@site}{} \renewcommand{\@dategame}{}
\renewcommand{\@round}{} \renewcommand{\@whiteplayer}{}
\renewcommand{\@blackplayer}{}
}% END GAMEHEADER
% this next macro by Donald Arsenau, see
% <4008a73c$0$22624$61ce578d@news.syd.swiftdsl.com.au>
\def\wrapfill{\par
\ifx\parshape\WF@fudgeparshape
\nobreak
\ifnum\c@WF@wrappedlines>\@ne
\advance\c@WF@wrappedlines\m@ne
\vskip\c@WF@wrappedlines\baselineskip
\global\c@WF@wrappedlines\z@
\fi
\allowbreak
\WF@finale
\fi
}
\makeatother
\begin{document}
\tinyboard
\notationOff
\tableofcontents
';
my $enddoc='\end{document}';
my $pgnfile = shift || die "filename required\n";
my $pgn = new Chess::PGN::Parse $pgnfile
or die "can't open $pgnfile\n";
my $output = "$pgnfile.tex";
sub printboard
{
print OUT "\n\n\\smallskip\n".
"\\needspace{50pt}\n".
"\\begin{wrapfigure}[8]{r}{78pt}\n".
"\\showboard\n".
"\\end{wrapfigure}\n";
}
# In this subroutine, we want to convert a string like: "({7:+0.42} 10. ... c6 11. O-O-O
# $14) ({0:+0.00} 10. ... dxc4 $10)" into
# \textit{[7:+0.42]} \movecomment{ 10... c6 11. O-O-O }\wbetter
# \textit{[0:+0.00]} \movecomment{ 10... dxc4 }\equalp
sub fix_variation
{
$_=$_[0];
s/\({/{/g;
s/}/}\(/g;
s/{/\\textit{\[/g;
s/}/\]}/g;
s/\[ /\[/g;
s/ \]/\]/g;
s/\(/ \\movecomment{/g;
s/\)/}\n/g;
s/}\n \\textit{/} \n\n \\textit{/g;
s/ }/}/g;
s/\$18}/}\\wdecisive/g;
s/\$16}/}\\wupperhand/g;
s/\$14}/}\\wbetter/g;
s/\$19}/}\\bdecisive/g;
s/\$17}/}\\bupperhand/g;
s/\$15}/}\\bbetter/g;
s/\$10}/}\\equalp/g;
return $_;
}
open(OUT, ">$output");
print OUT "$preamble";
while ($pgn->read_game()){
$pgn->parse_game({save_comments => 'yes'});
my $comments = $pgn->comments;
print OUT "\\event{",$pgn->event,"}\n"; # NOT "\\event{$pgn->event}\n";
print OUT "\\site{",$pgn->site,"}\n";
print OUT "\\dategame{",$pgn->date,"}\n";
print OUT "\\round{",$pgn->round,"}\n";
print OUT "\\whiteplayer{",$pgn->white,"}\n";
print OUT "\\blackplayer{",$pgn->black,"}\n";
print OUT "\\result{",$pgn->result,"}\n\n";
print OUT "\\eco{",$pgn->eco,"}\n\n";
print OUT '\\gameheader
\newgame
\mainline{';
my $total_plys= @{$pgn->moves};
my $ply =0;
while ($ply<$total_plys) {
my $move = int($ply/2)+1;
if (!($ply % 2)) # ply corresponds to a white move
{
print OUT "$move. @{$pgn->moves}[$ply] ";
if ($$comments{"${move}w"})
{
print OUT "}";
&printboard;
print OUT &fix_variation($$comments{"${move}w"});
print OUT "\\wrapfill\n\n";
}
}
else
{
if ($$comments{"${move}w"}) {
print OUT "\\smallskip\n\\mainline{$move... @{$pgn->moves}[$ply] "}
else {
print OUT "@{$pgn->moves}[$ply] "
}
if ($$comments{"${move}b"})
{
print OUT "}";
&printboard;
print OUT &fix_variation($$comments{"${move}b"});
print OUT "\\wrapfill\n";
print OUT "\\smallskip\n\\mainline{"
}
}
++$ply;
}
print OUT "}\\hspace{\\stretch{1}} \\textbf{[\\thisresult]}\n\n";
}
print OUT "\n$enddoc";
close(OUT);
------------------------------
Date: Wed, 21 Apr 2004 19:56:50 GMT
From: merlyn@stonehenge.com (Randal L. Schwartz)
Subject: Re: Asking for comments on this script
Message-Id: <9b83418159246a44a66a34d0f0a8479c@news.teranews.com>
>>>>> "Rafael" == Rafael Villarroel Flores <rvf_lists@fastmail.fm> writes:
Rafael> The following script already does what I want it to do, but I would
Rafael> appreciate if the experts here share any comment they may have that
Rafael> would help improve my Perl skills
This program *screams* for Template Toolkit. See www.tt2.org for
details.
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!
------------------------------
Date: Wed, 21 Apr 2004 16:21:19 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: Asking for comments on this script
Message-Id: <slrnc8dpef.1t8.tadmc@magna.augustmail.com>
Rafael Villarroel Flores <rvf_lists@fastmail.fm> wrote:
>
> The following script already does what I want it to do, but I would
> appreciate if the experts here share any comment they may have that
> would help improve my Perl skills
> my $preamble='\documentclass[twocolumn]{article}
[snip 70 lines of data]
> ';
Yikes!
The maintenance programmer is supposed to scan dozens of lines
until he gets to the couple of black pixels that make the single quote?
A "here-document" would be much easier to see. (see perlop.pod)
> print OUT "\n\n\\smallskip\n".
> "\\needspace{50pt}\n".
> "\\begin{wrapfigure}[8]{r}{78pt}\n".
> "\\showboard\n".
> "\\end{wrapfigure}\n";
I don't like to hide the concat operators from myself, so I'd write that:
print OUT "\n\n\\smallskip\n"
. "\\needspace{50pt}\n"
. "\\begin{wrapfigure}[8]{r}{78pt}\n"
. "\\showboard\n"
. "\\end{wrapfigure}\n";
(or use a here-doc again)
> s/\({/{/g;
s/ \( { / { /gx; # easier to see what it does
> open(OUT, ">$output");
You should always, yes *always*, check the return value from open().
> print OUT "$preamble";
perldoc -q vars
What's wrong with always quoting "$vars"?
So that should be:
print OUT $preamble; # quotes don't do anything, so they should not be there
> while ($ply<$total_plys) {
Whitespace is not a scarce resource, feel free to use as much as
you want to make your code easier to read an maintain:
while ( $ply < $total_plys ) {
(see perlstyle.pod)
> if (!($ply % 2)) # ply corresponds to a white move
I'd have written that differently:
if ( $ply % 2 == 0 ) # even moves are white
> &printboard;
perldoc -q function
What's the difference between calling a function as &foo and foo()?
Then change that to:
printboard();
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Wed, 21 Apr 2004 22:35:23 +0200
From: Michele Dondi <bik.mido@tiscalinet.it>
Subject: autobox
Message-Id: <a8md80hpokdvv3liauo7d79erbparqcs8b@4ax.com>
In a recent thread Tassilo v. Parseval said that the autobox
package/perl patch (besides pointing me to it - BTW: thanks!!) has
been rejected by p5p.
Now, I've tried it and I must say it is *cool* to say the least! So,
can anyone explain quickly the reason why it has been rejected? I know
I may ask directly there, but due to constraints of time and of lack
of technical know how on my part I'll try here: it's only a matter of
curiosity...
Michele
--
you'll see that it shouldn't be so. AND, the writting as usuall is
fantastic incompetent. To illustrate, i quote:
- Xah Lee trolling on clpmisc,
"perl bug File::Basename and Perl's nature"
------------------------------
Date: 21 Apr 2004 20:57:06 GMT
From: "Tassilo v. Parseval" <tassilo.parseval@rwth-aachen.de>
Subject: Re: autobox
Message-Id: <c66n72$8pf26$1@ID-231055.news.uni-berlin.de>
Also sprach Michele Dondi:
> In a recent thread Tassilo v. Parseval said that the autobox
> package/perl patch (besides pointing me to it - BTW: thanks!!) has
> been rejected by p5p.
To be more precise, it hasn't been formerly rejected. It was discussed
in length in a time when Jarkko was very busy preparing 5.8.1.
Eventually the topic was sort of postponed but never picked up again.
> Now, I've tried it and I must say it is *cool* to say the least! So,
> can anyone explain quickly the reason why it has been rejected? I know
> I may ask directly there, but due to constraints of time and of lack
> of technical know how on my part I'll try here: it's only a matter of
> curiosity...
You find the complete thread starting with this article here:
http://tinyurl.com/3cegc
Tassilo
--
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval
------------------------------
Date: 21 Apr 2004 13:25:22 -0700
From: lucid1@mediaone.net (Brian)
Subject: Re: capturing stderr from windows
Message-Id: <961d6f35.0404211225.276306ae@posting.google.com>
I am using Windows2000. Ah, I did not know precisely what was
happening with the use of 2>&1, nor did I know you could place it at
the end. I have been using it with unix and I guess the behavior is
different.
Thanks for the help! Much appreciated!
------------------------------
Date: 21 Apr 2004 12:15:22 -0700
From: Vilmos Soti <vilmos@vilmos.org>
Subject: Finding all open filehandles and closing them before exiting
Message-Id: <87ad15nnw5.fsf@localhost.localdomain>
Hello,
I am trying to find all open filehandles in my program and close
them before exiting.
Among many things, my program mounts a disk (runs under Linux),
finds all files with File::Find, then copies the files with
File::Copy. I use filenames as parameters to copy in order to
keep my program simple, and also because the manpage for File::Copy
recommends using filenames wherever possible.
I have a signal handler which tries to unmount the disk in
the case of a sigint, but it will fail if copy from File::Copy
has an open filehandle on the mounted disk.
Here is a short program which fully illustrates my problem:
(I excluded the checking of return values for the sake of keeping
this short program, well, short)
#################### program starts ####################
#!/usr/bin/perl -w
use strict;
use File::Copy;
sub bye () {
print "in function bye\n";
system ("umount /tmp/mountpoint");
exit;
}
$SIG{INT} = \&bye;
system ("mount -o loop /tmp/filesystem.img /tmp/mountpoint");
system ("ls -l /tmp/mountpoint");
print "copy starts\n";
copy ("/tmp/mountpoint/devzero", "/tmp/mountpoint/devnull");
#################### program ends ####################
And here are the results after running the program:
#################### results start ####################
[root@cord pts/6 tmp]# ./a.pl
total 12
crw-rw-rw- 1 root root 1, 3 Dec 31 1969 devnull
crw-rw-rw- 1 root root 1, 5 Dec 31 1969 devzero
drwxr-xr-x 2 root root 12288 Apr 21 11:19 lost+found
copy starts
in function bye
umount: /tmp/mountpoint: device is busy
[root@cord pts/6 tmp]#
#################### results end ####################
Is there any way to find all open files and close them?
Or a way to close all open files apart from stdin, stdout, and stderr?
I (possibly naively) tried to iterate through %main:: and find
all filehandles, descend into additional structures if I need to,
but I didn't succeed. I just tried and tried and tried, and
failed and failed and failed.
Here is the code snipplet I had in the "bye" function.
#################### Code starts ####################
foreach my $key (sort keys %main::) {
my $x = \$main::{$key};
print $x;
print "\n";
}
#################### Code ends ####################
However, it returned only GLOBs. I am out of ideas.
Of course, I could write my own copy function, but I would
prefer to use the already existing functions, and also to
keep my code small and simple.
Also, I could close the FROM and TO filehandles in bye,
but that, besides being an ugly hack is an understatement,
is not a general solution, and has no learning value.
I hope I provided enough information about my misery and
my efforts of how I tried to solve it.
Thanks, Vilmos
------------------------------
Date: Wed, 21 Apr 2004 18:55:30 -0000
From: "David K. Wall" <dwall@fastmail.fm>
Subject: Re: grepping lines above and below a pattern found
Message-Id: <Xns94D297D2B5106dkwwashere@216.168.3.30>
Abhinav <matrix_calling@yahoo.dot.com> wrote:
> mike wrote:
>
>> say i have this in a text file
>>
>> "Use this form to
>> post your messages.
>> Remember that
>> it can be viewed by
>> millions of people worldwide.
>> For questions about posting,
>> check our FAQ"
>>
>> what is the most commonly used way to print ,say , 2 lines above
>> and 2 lines below a certain pattern found such that my output is
>>
>> "post your messages.
>> Remember that
>> it can be viewed by
>> millions of people worldwide.
>> For questions about posting, "
>>
>> for the matched pattern "viewed" .
>>
>> thanks...
> Is this allowed ?
>
> system "grep -A2 -B2 $pattern $file";
Might not work well on an OS without grep. :-)
I'm tired of the question, anyway. How's this for a fairly general
solution? The interface could probably be improved -- and I suppose
it would be easier to just use Tie::File and loop through the lines.
use strict;
use warnings;
print join "...\n",
lines_around(
qr/\bviewed\b/i,
*DATA,
{before => 2, after => 2}
);
sub lines_around {
# pattern in filehandle with options...
my ($pattern, $filehandle, $options) = @_;
$options->{before} = defined $options->{before}
? $options->{before}
: 1;
$options->{after} = defined $options->{after}
? $options->{after}
: 1;
# return matching line, default 1
$options->{match} = defined $options->{match}
? $options->{match}
: 1;
# return first match only, default 0
$options->{first_only} = defined $options->{first_only}
? $options->{first_only}
: 0;
my (@buffer, @matches);
while (my $line = <$filehandle>) {
shift @buffer if @buffer > $options->{before};
push @buffer, $line;
next unless $line =~ /$pattern/;
pop @buffer unless $options->{match};
my @matched_lines;
push @matched_lines, @buffer;
push @matched_lines, scalar <DATA>
for 1 .. $options->{after};
return join('', @matched_lines) if $options->{first_only};
push @matches, join '', @matched_lines;
@buffer = ();
}
return @matches;
}
__DATA__
Use this form to
post your messages.
Remember that
it can be VIEWED by
millions of people worldwide.
For questions about posting,
check our FAQ
Use this form to
post your messages.
Remember that
it can be VIEWED by
millions of people worldwide.
For questions about posting,
check our FAQ
------------------------------
Date: Wed, 21 Apr 2004 21:44:36 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: grepping lines above and below a pattern found
Message-Id: <4086EB21.CF01E2C3@acm.org>
mike wrote:
>
> say i have this in a text file
>
> "Use this form to
> post your messages.
> Remember that
> it can be viewed by
> millions of people worldwide.
> For questions about posting,
> check our FAQ"
>
> what is the most commonly used way to print ,say , 2 lines above and 2
> lines below a certain pattern found such that my output is
>
> "post your messages.
> Remember that
> it can be viewed by
> millions of people worldwide.
> For questions about posting, "
>
> for the matched pattern "viewed" .
my $above = 2;
my $below = 2;
my @buffer;
while ( <> ) {
@buffer = ( @buffer, $_ )[ -( $above + 1 ) .. -1 ];
/viewed/ && print @buffer, map scalar <>, 1 .. $below;
}
John
--
use Perl;
program
fulfillment
------------------------------
Date: Wed, 21 Apr 2004 16:31:34 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: grepping lines above and below a pattern found
Message-Id: <slrnc8dq1m.1t8.tadmc@magna.augustmail.com>
mike <s99999999s2003@yahoo.com> wrote:
> say i have this in a text file
>
> "Use this form to
> post your messages.
> Remember that
> it can be viewed by
> millions of people worldwide.
> For questions about posting,
> check our FAQ"
>
> what is the most commonly used way to print ,say , 2 lines above and 2
> lines below a certain pattern found such that my output is
>
> "post your messages.
> Remember that
> it can be viewed by
> millions of people worldwide.
> For questions about posting, "
>
> for the matched pattern "viewed" .
------------------------------
#!/usr/bin/perl
use warnings;
use strict;
use Tie::File;
my $filename = 'text.file';
tie my @array, 'Tie::File', $filename, autochomp => 0 or
die "could not tie file $!";
foreach my $i ( 0 .. $#array ) {
print @array[ $i-2 .. $i+2 ] if $array[$i] =~ /viewed/;
}
untie @array;
------------------------------
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Wed, 21 Apr 2004 19:32:45 GMT
From: Bart Lateur <bart.lateur@pandora.be>
Subject: Re: Match Offset: length($`)
Message-Id: <suid8014on6q5telsv9k87ioqpjg782skq@4ax.com>
Marco wrote:
> I can run the match and
>then get the length of $` ($PREMATCH)
Look into the array @- (perlvar), in particular, the element at index 0.
$_ = " There's some food at the bar";
/foo/ and print "Found at offset $-[0]\n";
which prints
Found at offset 14
--
Bart.
------------------------------
Date: 21 Apr 2004 12:58:08 -0700
From: andreas.hochsteger@oeamtc.at (Andreas Hochsteger)
Subject: Negation of RegEx
Message-Id: <5b383d9e.0404211158.413497f4@posting.google.com>
Hi,
is it possible to construct a single regular expression which matches
everything except strings which start with a certain string?
I need it for matching Paths and want to exclude certain directories.
Example:
Match all paths not starting with /forms/ or /users/:
/index.php and /contact/index.php should match, but not
/forms/contact.php as well es /users/login.php.
Any ideas?
Please have in mind, that I have to use the regular expression in a
configuration file so it's not possible to do the negation from within
a programming language.
Thanks,
Andreas.
------------------------------
Date: Wed, 21 Apr 2004 20:11:49 GMT
From: merlyn@stonehenge.com (Randal L. Schwartz)
To: andreas.hochsteger@oeamtc.at (Andreas Hochsteger)
Subject: Re: Negation of RegEx
Message-Id: <9b154d503788c903f263b4cd5577e68a@news.teranews.com>
>>>>> "Andreas" == Andreas Hochsteger <andreas.hochsteger@oeamtc.at> writes:
Andreas> is it possible to construct a single regular expression which matches
Andreas> everything except strings which start with a certain string?
The regex
/^(?!FOO)/
matches everything except lines that start with FOO.
print "Just another Perl hacker,"; # and the first one, at that
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!
------------------------------
Date: Wed, 21 Apr 2004 14:53:53 -0600
From: Eric Schwartz <emschwar@pobox.com>
Subject: Re: Negation of RegEx
Message-Id: <etooeplf3xa.fsf@fc.hp.com>
andreas.hochsteger@oeamtc.at (Andreas Hochsteger) writes:
> is it possible to construct a single regular expression which matches
> everything except strings which start with a certain string?
> I need it for matching Paths and want to exclude certain directories.
Randal's answer answers your specific question, but you can also solve
the problem in other ways:
if your code looks like:
if (/regex matching items you like/) {
...
}
you can also write it like this:
unless (/regex matching items you don't like/) {
...
}
or
unless ($item !~ /regex matching items you don't like/) {
...
}
But the last example uses !~, which is considered confusing by some,
so I don't recommend it.
-=Eric
--
Come to think of it, there are already a million monkeys on a million
typewriters, and Usenet is NOTHING like Shakespeare.
-- Blair Houghton.
------------------------------
Date: Wed, 21 Apr 2004 21:11:53 GMT
From: merlyn@stonehenge.com (Randal L. Schwartz)
Subject: Re: Negation of RegEx
Message-Id: <d9a605583b57a34997830cd39602df02@news.teranews.com>
>>>>> "Eric" == Eric Schwartz <emschwar@pobox.com> writes:
Eric> you can also write it like this:
Eric> unless (/regex matching items you don't like/) {
Eric> ...
Eric> }
Yes, but Original Poster said:
OP> Please have in mind, that I have to use the regular expression in
OP> a configuration file so it's not possible to do the negation from
OP> within a programming language.
Hence, non-solution, even from a Schwartz. :)
print "Just another Perl hacker,"; # the first!
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!
------------------------------
Date: Wed, 21 Apr 2004 22:35:20 +0200
From: Michele Dondi <bik.mido@tiscalinet.it>
Subject: Re: One question
Message-Id: <0ijd80h2gf9iavdsesr4im90f39mdaep7t@4ax.com>
On Tue, 20 Apr 2004 16:44:51 -0500, Tad McClellan
<tadmc@augustmail.com> wrote:
>>> enough context, (ii) was referring to the fact you said something to
>>> the effect that calling your perl program from console would have
>>> required major hassles in terms of chdir()s et similia IIRC, which is
>>> utter nonsense IMO, etc.
>>
>> I am not trying to argue with you about any of these topics.
>
>No, you are simply ignoring these topics.
But what's worst he *started* these topics in the first place!
Michele
--
you'll see that it shouldn't be so. AND, the writting as usuall is
fantastic incompetent. To illustrate, i quote:
- Xah Lee trolling on clpmisc,
"perl bug File::Basename and Perl's nature"
------------------------------
Date: Wed, 21 Apr 2004 14:10:20 -0400
From: Paul Lalli <ittyspam@yahoo.com>
Subject: Re: sort numeric lists
Message-Id: <20040421140913.E15178@dishwasher.cs.rpi.edu>
On Wed, 21 Apr 2004, Jim Gibson wrote:
> In article <x78ygpo5si.fsf@mail.sysarch.com>, Uri Guttman
> <uri@stemsystems.com> wrote:
>
> > that will not be any better than his code. 2 separate sorts will not do it.
>
> I am afraid that is incorrect. You can emulate a multi-column sort by
> sorting on individual columns in multiple passes provided 1) you have a
> stable sort (sequence-preserving) and 2) you sort in inverse order of
> priority. Try it and see.
The OP has already stated that he only has Perl 5.6 available to him.
Perl's sort() did not become stable until v5.8.0
Paul Lalli
------------------------------
Date: 21 Apr 2004 19:15:29 GMT
From: Glenn Jackman <xx087@freenet.carleton.ca>
Subject: Re: variable interpolation failed :-(
Message-Id: <slrnc8di2j.nel.xx087@smeagol.ncf.ca>
fred <fred@no-spam.fr> wrote:
> in fact my programm is more complicated : it removes the extension of the
> file, it removes the blancs and truncate the file name. It is ugly but it
> works ;-)
>
>
> while (my $nom_fichier = <LISTE>) {
> chomp($nom_fichier); # file name
> $nom_fichier =~
> m/$source_directory\/(.{5,$longueur_maxi_titre_final}).*$/ ; # truncate
> the file name
> my $nom_fichier_final = $1;
> my $motif = '\.pdf' ;
> $nom_fichier_final =~ s/$motif// ; # remove PDF
> $nom_fichier_final =~ s/ /_/g ; # remove blancs
> $nom_fichier_final = "$target_directory"."/$nom_fichier_final"
> .".$extension"; # target file name
> $nom_fichier =~ s/ /\\ /g ;
> print "intitial : $nom_fichier\n";
> print "final : $nom_fichier_final\n";
> system ("cp $nom_fichier $nom_fichier_final"); # copy the new file
> }
That could be written as:
# no reason to ever end a regex with ".*$", unless you're capturing it
my $re = qr{$source_directory/(.+)\.pdf$}o;
while (my $nom_fichier = <LISTE>) {
chomp $nom_fichier;
if ($nom_fichier =~ /$re/) {
# I assume $target_directory doesn't have any spaces
(my $nom_fichier_final = "$target_directory/$1.$extension")
=~ s/ /_/g;
print "initial: '$nom_fichier'\n";
print "final: '$nom_fichier_final'\n";
# don't have to worry about spaces in filenames when calling
# system with more then one argument
system 'cp', $nom_fichier, $nom_fichier_final;
}
}
--
Glenn Jackman
NCF Sysadmin
glennj@ncf.ca
------------------------------
Date: Wed, 21 Apr 2004 22:47:38 +0200
From: "fred" <fred@no-spam.fr>
Subject: Re: variable interpolation failed :-(
Message-Id: <pan.2004.04.21.20.47.37.897940@no-spam.fr>
very elegant solution ;-)
because I want the final file name length between 5 and
$longueur_maxi_titre_final, I changed this line :
my $re = qr{$source_directory/(.{5,$longueur_maxi_titre_final}).*\.pdf$}o;
------------------------------
Date: Wed, 21 Apr 2004 22:51:50 +0200
From: "fred" <fred@no-spam.fr>
To: Glenn Jackman <xx087@freenet.carleton.ca>
Subject: Re: variable interpolation failed :-(
Message-Id: <pan.2004.04.21.20.51.50.13080@no-spam.fr>
very elegant solution ;-)
because I want the final file name length between 5 and
$longueur_maxi_titre_final, I changed this line :
my $re = qr{$source_directory/(.{5,$longueur_maxi_titre_final}).*\.pdf$}o;
------------------------------
Date: 21 Apr 2004 21:19:20 GMT
From: Glenn Jackman <xx087@freenet.carleton.ca>
Subject: Re: variable interpolation failed :-(
Message-Id: <slrnc8dpaq.nel.xx087@smeagol.ncf.ca>
fred <fred@no-spam.fr> wrote:
> because I want the final file name length between 5 and
> $longueur_maxi_titre_final, I changed this line :
>
> my $re = qr{$source_directory/(.{5,$longueur_maxi_titre_final}).*\.pdf$}o;
I assume your value 5 includes 4 characters for '.pdf'
That regex will not match "$source_directory/abc.pdf" because there
aren't 5 characters between the slash and the extension.
You might want to use smaller values:
$longueur_maxi_titre_final -= 4;
my $re = qr{$source_directory/(.{1,$longueur_maxi_titre_final}).*\.pdf$}o;
Or, you could capture a filename of any length and then truncate the
base filename if it's too long.
--
Glenn Jackman
NCF Sysadmin
glennj@ncf.ca
------------------------------
Date: Wed, 21 Apr 2004 16:45:26 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: variable interpolation failed :-(
Message-Id: <slrnc8dqrm.1t8.tadmc@magna.augustmail.com>
fred <fred@no-spam.fr> wrote:
> $nom_fichier =~
> m/$source_directory\/(.{5,$longueur_maxi_titre_final}).*$/ ; # truncate
> the file name
> my $nom_fichier_final = $1;
You should never use the dollar-digit variables unless you
have first ensured that the pattern match _succeeded_. [1]
die "match failed !" unless $nom_fichier =~ m/$source_directory...
my $nom_fichier_final = $1; # safe to use $1 here
> $nom_fichier_final =~ s/ /_/g ; # remove blancs
The comment is misleading. "replace" is not the same as "remove".
$nom_fichier_final =~ tr/ /_/ ; # replace blancs (only faster)
> $nom_fichier_final = "$target_directory"."/$nom_fichier_final"
> .".$extension"; # target file name
Yuck!
$nom_fichier_final =
"$target_directory/$nom_fichier_final.$extension";
Now the path _looks like_ the path.
> system ("cp $nom_fichier $nom_fichier_final"); # copy the new file
Better check the return value from system() if you care about
whether the copy worked or not...
[1] See me make this very same mistake here some years ago:
Message-ID: <uk68f9cg8b.fsf@linda.teleport.com>
See Randal set me straight too. :-)
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Wed, 21 Apr 2004 21:15:41 +0200
From: Tore Aursand <tore@aursand.no>
Subject: Re: Writing dupliactes to database file
Message-Id: <pan.2004.04.21.19.15.19.673731@aursand.no>
On Wed, 21 Apr 2004 10:02:44 -0700, Testor wrote:
> open(DATABASE, ">>bnkrecpts.db") or die "Can't write open file.
> Reason: $!";
> seek(DATABASE,0,2);
> print DATABASE "$myreceipt\n";
> close(DATABASE);
>
> This works OK though not sure if it's the best way because I'm writing
> duplicate receipt numbers. I tried to use an if statement to make sure
> is the number exists in the file before writing it but I'm afraid I
> wasn't successful I did something like:
>
> open (THERECEIPT, "bnkrecpts.db") or die "Can't open file. Because:
> $!";
> flock(THERECEIPT,2);
> $receiptnum = <THERECEIPT>;
> close (THERECEIPT);
>
> if ($receiptnum eq $myreceipt) {
> stop and redirect or print something to the page etc..
>
> }
This is partly answered in the Perl FAQ;
perldoc -q duplicate
Anyway. You could take a look at the following code which might help you
get a clue;
my $filename = 'bnkrecpts.db';
my $receipt = $query->param('receipt') || '';
if ( $receipt ) {
my $receipt_exists = 0;
open( THERECEIPT, '<', $filename ) or die "$!\n";
while ( <THERECEIPT> ) {
chomp;
if ( $_ eq $receipt ) {
$receipt_exists++;
last;
}
}
close( THERECEIPT );
unless ( $receipt_exists ) {
open( THERECEIPT, '>>', $filename ) or die "$!\n";
print THERECEIPT "$receipt\n";
close( THERECEIPT );
}
}
Fill in with file locking etc. as it suits you. The code above is a
simple example and has not been tested or anything.
Hope it helps, though.
--
Tore Aursand <tore@aursand.no>
"The pure and simple truth is rarely pure and never simple." (Oscar
Wilde)
------------------------------
Date: 21 Apr 2004 14:02:30 -0800
From: yf110@vtn1.victoria.tc.ca (Malcolm Dew-Jones)
Subject: Re: Writing dupliactes to database file
Message-Id: <4086e166@news.victoria.tc.ca>
Testor (extended@operamail.com) wrote:
: Hi all,
: I posted this message in comp.lang.perl, but someone suggested I post
: to this group instead. I wish I could delete the other one I hope
: admins will note this.
: Anyway, here goes:
: I am writing a simple perl script to learn in the process. The script
: is supposed to grab a receipt number from the query-string and write
: it into a file.
: To do that, here's what I did:
: $query = new CGI;
: $myreceipt = $query->param('bnkreceipt');
: open(DATABASE, ">>bnkrecpts.db") or die "Can't write open file.
: Reason: $!";
: seek(DATABASE,0,2);
: print DATABASE "$myreceipt\n";
: close(DATABASE);
: This works OK though not sure if it's the best way because I'm writing
: duplicate receipt numbers. I tried to use an if statement to make sure
: is the number exists in the file before writing it but I'm afraid I
: wasn't successful I did something like:
: open (THERECEIPT, "bnkrecpts.db") or die "Can't open file. Because:
: $!";
: flock(THERECEIPT,2);
: $receiptnum = <THERECEIPT>;
: close (THERECEIPT);
I just wanted to say one thing.
Once you close the file then the lock goes away. You have to check the
contents and write the new number _while the file is still open_.
(Assuming you use this technique at all.)
open read write
flock
read file to see what's in it
write any new values into the right place in the file
(if file should be shorter then truncate to the right length)
close (flock goes away)
------------------------------
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.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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 6442
***************************************
