[31668] in Perl-Users-Digest
Perl-Users Digest, Issue: 2931 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed May 5 18:09:29 2010
Date: Wed, 5 May 2010 15:09: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, 5 May 2010 Volume: 11 Number: 2931
Today's topics:
Bug in GD? <newsojo@web.de>
Re: Bug in GD? <ben@morrow.me.uk>
Daemons and flie locking <dean.karres@gmail.com>
Re: Daemons and flie locking <ben@morrow.me.uk>
find/copy most recent version of file? <geoff@invalid.invalid>
Re: find/copy most recent version of file? <jurgenex@hotmail.com>
Re: find/copy most recent version of file? <m@rtij.nl.invlalid>
Re: find/copy most recent version of file? <jmcguire@liaison-intl.com>
help me to write better code <sopan.shewale@gmail.com>
Re: help me to write better code <ben@morrow.me.uk>
Re: help me to write better code <smallpond@juno.com>
Re: help me to write better code <willem@turtle.stack.nl>
Re: help me to write better code <sopan.shewale@gmail.com>
Re: help me to write better code <ben@morrow.me.uk>
Re: One liner to remove duplicate records sln@netherlands.com
Re: XML Replace sln@netherlands.com
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 05 May 2010 20:53:17 GMT
From: 0liver 'ojo' Bedf0rd <newsojo@web.de>
Subject: Bug in GD?
Message-Id: <4be1dabd$0$6774$9b4e6d93@newsspool3.arcor-online.net>
The following code:
#!/usr/bin/perl -w
use strict;
use GD;
my $im = new GD::Image(500,500);
my $white = $im->colorAllocate(255,255,255);
my $black = $im->colorAllocate(0,0,0);
my $red = $im->colorAllocate(255,0,0);
my $blue = $im->colorAllocate(0,0,255);
$im->arc(100,100,50,50,90,90,$blue);
$im->filledArc(200,200,50,50,90,90,$red,gdEdged|gdNoFill);
binmode STDOUT;
print $im->png;
produces full (360 °) circles in the output image, although I would
have guessed that no output at all (or a single pixel/line) is produced.
I still find it more sensible to assume that if start and end angle
are the same "minimal" output is created and not the "maximum" one.
So: am I wrong or is this a bug in GD?
Oliver
------------------------------
Date: Wed, 5 May 2010 22:59:15 +0100
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: Bug in GD?
Message-Id: <ja69b7-qhe1.ln1@osiris.mauzo.dyndns.org>
Quoth 0liver 'ojo' Bedf0rd <newsojo@web.de>:
>
> produces full (360 °) circles in the output image, although I would
> have guessed that no output at all (or a single pixel/line) is produced.
> I still find it more sensible to assume that if start and end angle
> are the same "minimal" output is created and not the "maximum" one.
>
> So: am I wrong or is this a bug in GD?
What do the docs say?
AFAICS, a full circle is more useful. There are many ways of producing a
single line; a full circle, however, can only be produced like that.
Ben
------------------------------
Date: Wed, 5 May 2010 13:49:27 -0700 (PDT)
From: Dean Karres <dean.karres@gmail.com>
Subject: Daemons and flie locking
Message-Id: <b5607df1-a8f5-4dc9-821b-e27ff50ec60a@a21g2000yqn.googlegroups.com>
Hi,
Tested on RedHat and Ubuntu
I am trying to create a daemon the tails and parses a "binary" (fixed
length record) log-file. I have tried using Proc::Daemon and rolling
my own daemonization code and I really don't think that is the issue
though. My problem is when I try to create a run-lock pid file in /
var/run.
the basic flow is:
- start syslog
- become a daemon
- try to create/open & flock a pid file
- ... everything else
I know syslog is working even after the forks. I know the forks are
working. I know the pid file is being initially created but flock
bombs and tells me "Inappropriate ioctl for device".
the pid file open code is:
sysopen($PIDFILE, $PIDFILEPATH, O_CREAT | O_WRONLY) ||
die "Can not open pid file: $PIDFILEPATH\n";
if (flock($PIDFILE, LOCK_EX | LOCK_NB) != 0) {
die "Can not lock pid file: $PIDFILEPATH: $!: $?\n";
}
truncate($PIDFILE, 0) ||
die "Can not truncate pid file: $PIDFILEPATH\n";
print $PIDFILE "$$\n";
The "$PIDFILEPATH" is /var/run/filename.pid
ideas?
------------------------------
Date: Wed, 5 May 2010 22:57:24 +0100
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: Daemons and flie locking
Message-Id: <4769b7-qhe1.ln1@osiris.mauzo.dyndns.org>
Quoth Dean Karres <dean.karres@gmail.com>:
>
> the basic flow is:
>
> - start syslog
> - become a daemon
> - try to create/open & flock a pid file
> - ... everything else
>
> I know syslog is working even after the forks. I know the forks are
> working. I know the pid file is being initially created but flock
> bombs and tells me "Inappropriate ioctl for device".
>
> the pid file open code is:
>
> sysopen($PIDFILE, $PIDFILEPATH, O_CREAT | O_WRONLY) ||
> die "Can not open pid file: $PIDFILEPATH\n";
> if (flock($PIDFILE, LOCK_EX | LOCK_NB) != 0) {
Perl's flock returns true on success and false on failure. All false
values compare numerically equal to 0, so this test is exactly
backwards. The value in $! is from some other error. Try
if (!flock($PIDFILE, LOCK_EX|LOCK_NB)) {
or, in the same style as the other lines
flock($PIDFILE, LOCK_EX|LOCK_NB) ||
die ...;
> die "Can not lock pid file: $PIDFILEPATH: $!: $?\n";
Why do you include $? here? What possible relevance does the exit status
of the last waited process have?
Ben
------------------------------
Date: Wed, 05 May 2010 06:46:41 +0100
From: Geoff <geoff@invalid.invalid>
Subject: find/copy most recent version of file?
Message-Id: <8a12u5pm4niduq3t709pltoeapd5uss8qk@4ax.com>
Hello
I have a series of files called c1_1.mp4 to c1_120.mp4 which are
spread over several folders.
I would like to be able to copy the most recent version of each file
to new folder.
Any pointers as to hwo to do this would be appreciated!
I can use
use File::Find;
to move through all the sub-folders but beyond that I'm not clear how
to do this.
Thanks
Geoff
------------------------------
Date: Wed, 05 May 2010 01:58:48 -0700
From: Jürgen Exner <jurgenex@hotmail.com>
Subject: Re: find/copy most recent version of file?
Message-Id: <ufc2u5d97pgocgmi6qmkc673eftioj4r0v@4ax.com>
Geoff <geoff@invalid.invalid> wrote:
>I have a series of files called c1_1.mp4 to c1_120.mp4 which are
>spread over several folders.
>I would like to be able to copy the most recent version of each file
>to new folder.
That is more of an algorithmic problem than a Perl problem.
The easiest way: walk through all the possible source folders and copy
each c1_*.mp4 file into your target directory unless there exists a file
with the same name in the target directory already and the existing file
is newer than the file to be copied.
jue
------------------------------
Date: Wed, 5 May 2010 11:25:15 +0200
From: Martijn Lievaart <m@rtij.nl.invlalid>
Subject: Re: find/copy most recent version of file?
Message-Id: <r4q7b7-gau.ln1@news.rtij.nl>
On Wed, 05 May 2010 01:58:48 -0700, Jürgen Exner wrote:
> Geoff <geoff@invalid.invalid> wrote:
>>I have a series of files called c1_1.mp4 to c1_120.mp4 which are spread
>>over several folders.
>>I would like to be able to copy the most recent version of each file to
>>new folder.
>
> That is more of an algorithmic problem than a Perl problem. The easiest
> way: walk through all the possible source folders and copy each c1_*.mp4
> file into your target directory unless there exists a file with the same
> name in the target directory already and the existing file is newer than
> the file to be copied.
That would mean a lot of unnecessary copying. I would do
# PSEUDO CODE!!
sub wanted {
my $fname = get the filename
my $fqfname = get the filename with path
my $mtime = (stat($fwfname)[MTIME];
if (not exists $file2copy{$fname} or
$file2copy{$fname}{mtime} < $mtime) {
$file2copy{$fname}{mtime} = $mtime;
$file2copy{$fname}{fqfname} = $fwfname;
}
}
Now you can just walk the $file2copy hash and process all entries.
HTH,
M4
------------------------------
Date: Wed, 5 May 2010 08:57:04 -0700 (PDT)
From: Justin M <jmcguire@liaison-intl.com>
Subject: Re: find/copy most recent version of file?
Message-Id: <2fc5fac7-59a8-43b7-a832-96e172dcbaba@p2g2000yqh.googlegroups.com>
On May 5, 1:46=A0am, Geoff <ge...@invalid.invalid> wrote:
> Hello
>
> I have a series of files called c1_1.mp4 to c1_120.mp4 which are
> spread over several folders.
>
> I would like to be able to copy the most recent version of each file
> to new folder.
>
> Any pointers as to hwo to do this would be appreciated!
>
> I can use
>
> use File::Find;
>
> to move through all the sub-folders but beyond that I'm not clear how
> to do this.
>
> Thanks
>
> Geoff
Use "stat," http://perldoc.perl.org/functions/stat.html
Similar to Martijn's solution...
#!/usr/bin/perl -l
use strict;
use warnings;
use File::Find;
my %file_access;
my %file_full;
die "dirs required\n" unless @ARGV;
find(\&wanted, @ARGV);
print foreach values %file_full;
sub wanted {
return unless /hello/; ## redo this with your own file pattern,
likely /^cl_\d+\.mp4$/
my $access_time =3D (stat($_))[9];
return if ($file_access{$_} and $access_time < $file_access{$_});
$file_full{$_} =3D $File::Find::name;
$file_access{$_} =3D $access_time;
}
------------------------------
Date: Wed, 5 May 2010 12:01:03 -0700 (PDT)
From: "sopan.shewale@gmail.com" <sopan.shewale@gmail.com>
Subject: help me to write better code
Message-Id: <e9c70461-4afd-4c3b-a624-0936cfb12c5d@40g2000pry.googlegroups.com>
I need help to make following code better, the current one looks
little odd...
-----------
my $query = new App::Request(); ##similar to Catalyst::Request
my @uploads_objs = ();
my @filenames = ();
for ( 0 .. 9 ) {
if ( $_ == 0 ) {
if ( defined $query->{uploads}{ $query-
>param('filepath') } ) {
push @upload_objs,
$query->{uploads}{ $query->param('filepath') };
push @filenames, $query->param('filepath');
}
}
else {
if ( defined $query->{uploads}{ $query-
>param( 'filepath' . $_ ) } )
{
push @upload_objs,
$query->{uploads}{ $query->param( 'filepath' .
$_ ) };
push @filenames, $query->param( 'filepath' . $_ );
}
}
}
-----------
do you think i should define local variables to reduce number of lines/
chars in above code?
Thanks,
------------------------------
Date: Wed, 5 May 2010 20:12:04 +0100
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: help me to write better code
Message-Id: <4hs8b7-4pd1.ln1@osiris.mauzo.dyndns.org>
Quoth "sopan.shewale@gmail.com" <sopan.shewale@gmail.com>:
> I need help to make following code better, the current one looks
> little odd...
>
> -----------
>
> my $query = new App::Request(); ##similar to Catalyst::Request
> my @uploads_objs = ();
> my @filenames = ();
>
> for ( 0 .. 9 ) {
> if ( $_ == 0 ) {
> if ( defined $query->{uploads}{ $query-
> >param('filepath') } ) {
> push @upload_objs,
> $query->{uploads}{ $query->param('filepath') };
> push @filenames, $query->param('filepath');
> }
> }
> else {
> if ( defined $query->{uploads}{ $query-
> >param( 'filepath' . $_ ) } )
> {
> push @upload_objs,
> $query->{uploads}{ $query->param( 'filepath' .
> $_ ) };
> push @filenames, $query->param( 'filepath' . $_ );
> }
> }
>
> }
> -----------
>
> do you think i should define local variables to reduce number of lines/
> chars in above code?
Yes, absolutely. You can also remove the if/else by iterating over the
right list, and I always prefer using flow-control rather than
introducing another layer of nesting:
my $query = App::Request->new; # don't use METHOD OBJECT syntax
my (@upload_objs, @filenames); # no need to initialize
for ("", 1..9) {
my $filename = $query->param("filepath$_");
my $upload = $query->{uploads}{$filename};
defined $upload or next;
push @upload_objs, $upload;
push @filenames, $filename;
}
Ben
------------------------------
Date: Wed, 05 May 2010 15:19:09 -0400
From: Steve C <smallpond@juno.com>
Subject: Re: help me to write better code
Message-Id: <hrsgbt$7ih$1@news.eternal-september.org>
sopan.shewale@gmail.com wrote:
> I need help to make following code better, the current one looks
> little odd...
>
> -----------
use warnings;
use strict;
>
> my $query = new App::Request(); ##similar to Catalyst::Request
> my @uploads_objs = ();
> my @filenames = ();
>
# Why have 0 when you can just use the value that you want?
for ( "", 1 .. 9 ) {
> if ( defined $query->{uploads}{ $query-> param( 'filepath' . $_ ) } )
> {
> push @upload_objs,
> $query->{uploads}{ $query->param( 'filepath' . $_ ) };
> push @filenames, $query->param( 'filepath' . $_ );
> }
>
> }
------------------------------
Date: Wed, 5 May 2010 19:37:48 +0000 (UTC)
From: Willem <willem@turtle.stack.nl>
Subject: Re: help me to write better code
Message-Id: <slrnhu3i8c.aef.willem@turtle.stack.nl>
sopan.shewale@gmail.com wrote:
) I need help to make following code better, the current one looks
) little odd...
)
) -----------
)
) my $query = new App::Request(); ##similar to Catalyst::Request
) my @uploads_objs = ();
) my @filenames = ();
)
) for ( 0 .. 9 ) {
) if ( $_ == 0 ) {
) if ( defined $query->{uploads}{ $query-
)>param('filepath') } ) {
) push @upload_objs,
) $query->{uploads}{ $query->param('filepath') };
) push @filenames, $query->param('filepath');
) }
) }
) else {
) if ( defined $query->{uploads}{ $query-
)>param( 'filepath' . $_ ) } )
) {
) push @upload_objs,
) $query->{uploads}{ $query->param( 'filepath' .
) $_ ) };
) push @filenames, $query->param( 'filepath' . $_ );
) }
) }
)
) }
) -----------
)
) do you think i should define local variables to reduce number of lines/
) chars in above code?
The loop from 0 to 9 with the special case looks odd to start with.
You could make a loop on '' and 1 to 9, with ('', 1 .. 9)
Furthermore, local variables would indeed make the code easier to
read and look less odd. You're using the same thing three times.
The same thing, here, is a function call so it would help performance
as well.
Another thing you could do is to populate the @filenames array first,
and then use that in a second loop to populate the @uploads_objs array.
Like this:
my $query = App::Request->new();
my @filenames;
my @upload_objs;
for my $num ("", 1 .. 9) {
my $filepath = $query->param("filepath$num");
my $upload_ob = $query->{uploads}{$filepath};
if (defined $upload_ob) {
push @filenames, $filepath;
push @upload_objs, $upload_ob;
}
}
All of this can be done with grep() and map() functions, although that
is quite a complicated programming style to wrap your head around.
Something like this:
my $query = App::Request->new();
my @filenames = grep { defined $query->{uploads}{$_} }
map { $query->param("filepath$_") } ('', 1 .. 9);
my @upload_objs = @{$query->{uploads}}{@filenames};
Note that even though this is more concise, it actually
reads the 'uploads' hash twice and might not be as fast.
SaSW, Willem
--
Disclaimer: I am in no way responsible for any of the statements
made in the above text. For all I know I might be
drugged or something..
No I'm not paranoid. You all think I'm paranoid, don't you !
#EOT
------------------------------
Date: Wed, 5 May 2010 13:21:33 -0700 (PDT)
From: "sopan.shewale@gmail.com" <sopan.shewale@gmail.com>
Subject: Re: help me to write better code
Message-Id: <ae90645e-bb5c-40c5-8542-638194ed9c2d@v29g2000prb.googlegroups.com>
Thanks for the quick responses.. appreciate all of you !
It was very clean/best answers from SaSW, Willem and Ben
--sopan
On May 6, 12:37=A0am, Willem <wil...@turtle.stack.nl> wrote:
> sopan.shew...@gmail.com wrote:
>
> ) I need help to make following code better, the current one looks
> ) little odd...
> )
> ) -----------
> )
> ) my $query =3D new App::Request(); =A0 ##similar to Catalyst::Request
> ) my @uploads_objs =3D ();
> ) my @filenames =3D ();
> )
> ) for ( 0 .. 9 ) {
> ) =A0 =A0 =A0 =A0 if ( $_ =3D=3D 0 ) {
> ) =A0 =A0 =A0 =A0 =A0 =A0 if ( defined $query->{uploads}{ $query-
> )>param('filepath') } ) {
> ) =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 push @upload_objs,
> ) =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 $query->{uploads}{ $query->param('f=
ilepath') };
> ) =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 push @filenames, $query->param('filepat=
h');
> ) =A0 =A0 =A0 =A0 =A0 =A0 }
> ) =A0 =A0 =A0 =A0 }
> ) =A0 =A0 =A0 =A0 else {
> ) =A0 =A0 =A0 =A0 =A0 =A0 if ( defined $query->{uploads}{ $query-
> )>param( 'filepath' . $_ ) } )
> ) =A0 =A0 =A0 =A0 =A0 =A0 {
> ) =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 push @upload_objs,
> ) =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 $query->{uploads}{ $query->param( '=
filepath' .
> ) $_ ) };
> ) =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 push @filenames, $query->param( 'filepa=
th' . $_ );
> ) =A0 =A0 =A0 =A0 =A0 =A0 }
> ) =A0 =A0 =A0 =A0 }
> )
> ) =A0 =A0 }
> ) -----------
> )
> ) do you think i should define local variables to reduce number of lines/
> ) chars in above code?
>
> The loop from 0 to 9 with the special case looks odd to start with.
> You could make a loop on '' and 1 to 9, with ('', 1 .. 9)
>
> Furthermore, local variables would indeed make the code easier to
> read and look less odd. =A0You're using the same thing three times.
> The same thing, here, is a function call so it would help performance
> as well.
>
> Another thing you could do is to populate the @filenames array first,
> and then use that in a second loop to populate the @uploads_objs array.
>
> Like this:
>
> =A0my $query =3D App::Request->new();
> =A0my @filenames;
> =A0my @upload_objs;
>
> =A0for my $num ("", 1 .. 9) {
> =A0 =A0my $filepath =3D $query->param("filepath$num");
> =A0 =A0my $upload_ob =3D $query->{uploads}{$filepath};
> =A0 =A0if (defined $upload_ob) {
> =A0 =A0 =A0push @filenames, $filepath;
> =A0 =A0 =A0push @upload_objs, $upload_ob;
> =A0 =A0}
> =A0}
>
> All of this can be done with grep() and map() functions, although that
> is quite a complicated programming style to wrap your head around.
>
> Something like this:
>
> =A0my $query =3D App::Request->new();
>
> =A0my @filenames =3D grep { defined $query->{uploads}{$_} }
> =A0 =A0map { $query->param("filepath$_") } ('', 1 .. 9);
> =A0my @upload_objs =3D @{$query->{uploads}}{@filenames};
>
> Note that even though this is more concise, it actually
> reads the 'uploads' hash twice and might not be as fast.
>
> SaSW, Willem
> --
> Disclaimer: I am in no way responsible for any of the statements
> =A0 =A0 =A0 =A0 =A0 =A0 made in the above text. For all I know I might be
> =A0 =A0 =A0 =A0 =A0 =A0 drugged or something..
> =A0 =A0 =A0 =A0 =A0 =A0 No I'm not paranoid. You all think I'm paranoid, =
don't you !
> #EOT
------------------------------
Date: Wed, 5 May 2010 22:51:06 +0100
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: help me to write better code
Message-Id: <ar59b7-qhe1.ln1@osiris.mauzo.dyndns.org>
Quoth Willem <willem@turtle.stack.nl>:
>
> Something like this:
>
> my $query = App::Request->new();
>
> my @filenames = grep { defined $query->{uploads}{$_} }
> map { $query->param("filepath$_") } ('', 1 .. 9);
> my @upload_objs = @{$query->{uploads}}{@filenames};
>
> Note that even though this is more concise, it actually
> reads the 'uploads' hash twice and might not be as fast.
It's probably better to have one array anyway:
my @uploads =
grep defined $_->{obj},
map +{
name => $_,
obj => $query->{uploads}{$_},
},
map $query->param("filepath$_"),
"", 1..9;
Unwrapping that into two arrays (if that's really necessary) is then
just a matter of
my @filenames = map $_->{name}, @uploads;
my @upload_objs = map $_->{obj}, @uploads;
Ben
------------------------------
Date: Tue, 04 May 2010 11:31:56 -0700
From: sln@netherlands.com
Subject: Re: One liner to remove duplicate records
Message-Id: <bsp0u5h70im71mcvvon25dnb7od93qp99f@4ax.com>
On Fri, 30 Apr 2010 08:55:12 -0700 (PDT), Ninja Li <nickli2000@gmail.com> wrote:
>Hi,
>
>I have a file with the following sample data delimited by "|" with
>duplicate records:
>
>20100430|20100429|John Smith|-0.07|-0.08|
>20100430|20100429|John Smith|-0.07|-0.08|
>20100430|20100429|Ashley Cole|1.09|1.08|
>20100430|20100429|Bill Thompson|0.76|0.78|
>20100429|20100428|Time Apache|2.10|2.24|
>
>The first three fields "date_1", "date_2" and "name" are unique
>identifiers of a record.
>
>Is there a simple way, like a one liner to remove the duplicates such
>as with "John Smith"?
>
>Thanks in advance.
>
>Nick Li
Another way:
perl -anF"\|" -e "tr/|// > 1 and ++$seen{qq<@F[0..2]>} > 1 and next or print" file.txt
-sln
------------------------------
Date: Wed, 05 May 2010 09:38:11 -0700
From: sln@netherlands.com
Subject: Re: XML Replace
Message-Id: <f673u556lgh034jc1s4bs3o895kuj9d2qo@4ax.com>
On Sun, 02 May 2010 13:20:33 -0700, sln@netherlands.com wrote:
>On Wed, 28 Apr 2010 10:01:37 -0700 (PDT), Trev <trevor.dodds@gmail.com> wrote:
>
>>I'm trying to use Perl to replace a line in a few XML files I have.
>>
>>Example XML below, I'm wanting to change the Id= part from Id="/Local/
>>App/App1" to Id=/App1". I know there's an easy way to do this with
>>perl alone however I'm trying to use XML::Simple or any XML plugin for
>>perl.
>>
>><?xml version="1.0" encoding="UTF-8" standalone="no" ?>
>>
>><Profile xmlns="xxxxxxxxx" name="" version="1.1" xmlns:xsi="http://
>>www.w3.org/2001/XMLSchema-instance">
>>
>>
>> <Application Name="App1" Id="/Local/App/App1" Services="1" policy=""
>>StartApp="" Bal="5" sessInt="500" WaterMark="1.0"/>
>>
>>
>><AppProfileGuid>586e3456dt</AppProfileGuid>
>>
>></Profile>
>
>If what you need is all you state,
>this code should fix up your xml.
>Its restricted to just single tag-attribute pair.
>It works by parsing exclusionary and specific markup.
>
>The advantage here is that nothing else changes in the
>original markup, only the string content of Id is changed
>via the replacement side of the regex.
>This avoids formatting headaches with some writers.
>
>The regex may look simple for a parser, thats becuse it
>is custom to the specific task.
>The markup interraction is correct.
>
With a slight modification, multiple attr-val's can be done
within a single tag. Of course this includes some re-eval
fringe code (?{}) and a conditional (?() | ) but does the
same search and replace and on multiples.
Cheers!
-sln
Some output:
--------------------------
Id = "/Local/App/App1", (valnew = "App1")
Id2 = "/Local/App/App2", (valnew = "App2")
Id = '/Dummy/Test/iii', (valnew = 'iii')
Id = "/testing", (valnew = "testing")
Id = "/Dum
my/Test/iii
", (valnew = "iii")
Id = "/Dat/Inp/Out", (valnew = "Out")
Id = "/Local/App/App1", (valnew = "App1")
Id = "/Dummy/Test/iii", (valnew = "iii")
Id = "/Dat/Inp/Out", (valnew = "Out")
Tt = "TT/tt hello", (valnew = "tt hello")
Id = "/he llo", (valnew = "he llo")
-----------------------------
# -------------------------------------------
# rx_html_fixval2.pl
# -sln, 5/5/2010
#
# Util to search/replace attribute/val's from
# xml/html
# -------------------------------------------
use strict;
use warnings;
## Initialization
##
my $rxopen = "(?: Application )"; # Open tags , cannot be empty alternation
my $rxattr = "(?: Id.?|Tt )"; # Attributes we seek, cannot have an empty alternation
# "(?: \\w+ )";
use re 'eval';
my $topen = 0;
my $Rxmarkup = qr
{
(?(?{$topen}) # Begin Conditional
# Have <OPEN> ?
(?:
# Try to match next attr-val pair
\s+[^>]*? (?<=\s) (?<ATTR> $rxattr) \s*=\s* \K(?<VAL> ".+?"|'.+?')
(?= [^>]*? \s* /? > )
|
# No more attr-value pairs
(?{$topen = 0})
)
|
# Look for new <OPEN>
(?:
[^<]*
(?:
# Things that hide markup:
# - Comments/CDATA
(?: <! (?: \[CDATA\[.*?\]\] | --.*?-- | \[[A-Z][A-Z\ ]*\[.*?\]\] ) > ) \K
|
# Specific markup we seek:
# - OPEN tag
(?: < (?<OPEN> $rxopen \K) )
(?{$topen = 1})
)
|
< \K
)
) # End Conditional
}xs;
## Code
##
my $html = join '', <DATA>;
$html =~ s/$Rxmarkup/ fixval( $+{ATTR}, $+{VAL} ) /eg;
print "\n",$html;
exit (0);
## Subs
##
sub fixval {
return '' unless defined $_[1];
print "$_[0] = $_[1], ";
if ($_[1] =~ / \/ \s* (?<val>[^\/]+?) \s* (?<delim>["']) $/x) {
my $valnew = $+{delim}.$+{val}.$+{delim};
print "(valnew = $valnew)\n";
return $valnew;
}
print "(val unchanged)\n";
return $_[1];
}
__DATA__
<?xml version="1.0" encoding="UTF-8" standalone="no" ?>
<Profile xmlns="xxxxxxxxx" name="" version="1.1" xmlns:xsi="http://
www.w3.org/2001/XMLSchema-instance">
<Application Name="App1" Id="/Local/App/App1"
Id2="/Local/App/App2" Services="1" policy=""
StartApp="" Bal="5" sessInt="500" WaterMark="1.0"/>
<AppProfileGuid>586e3456dt</AppProfileGuid>
</Profile>
<Application
Name="App99" Id='/Dummy/Test/iii' Services="3"
policy="99" StartApp="2" Bal="7" sessInt="27"
WaterMark="4.3" />
<Application Id="/testing"
Name="App100" Id="/Dum
my/Test/iii
" Services="4"
policy="99" StartApp="2" Bal="7" sessInt="27"
WaterMark="4.3"/>
<Application
Name="Yyee" Id="/Dat/Inp/Out" Services="5"
policy="88" StartApp="" Bal="1" sessInt="8"
WaterMark="2.1"/>
<![INCLUDE CDATA [ <Application Name="App99" Id="//Test/can't see me"/> ]]>
<?xml version="1.0" encoding="UTF-8" standalone="no" ?>
<Profile
xmlns="xxxxxxxxx"
name=""
version="1.1"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
<Application
Name="App1" Id="/Local/App/App1" Services="1"
policy="" StartApp="" Bal="5" sessInt="500"
WaterMark="1.0"/>
<Application
Name="App99" Id="/Dummy/Test/iii" Services="3"
policy="99" StartApp="2" Bal="7" sessInt="27"
WaterMark="4.3"/>
<Application
Name="Yyee" Id="/Dat/Inp/Out" Services="5"
policy="88" StartApp="" Bal="1" sessInt="8"
WaterMark="2.1" Tt = "TT/tt hello"/>
<Application
Name="Yyee" Id="/he llo" Services="5"
policy="88" StartApp="" Bal="1" sessInt="8"
WaterMark="2.1"/>
<AppProfileGuid>586e3456dt</AppProfileGuid>
<AppProfileGuid>a46y2hktt7</AppProfileGuid>
<AppProfileGuid>mi6j77mae6</AppProfileGuid>
</Profile>
------------------------------
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:
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
Back issues are available via anonymous ftp from
ftp://cil-www.oce.orst.edu/pub/perl/old-digests.
#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 V11 Issue 2931
***************************************
