Perl substitute some content in a xml file - perl

I am a newbie of Perl. Now i am trying to use Perl to substitute some content in a xml file. the following code is my command
perl -pi -e "s/<Connector port=\"\d+\" protocol=\"HTTP/1.1\" /<Connector port=\"${ACCESS_PORT}\" protocol=\"HTTP/1.1\" /g" $TOMCAT_SERVER_CONF
but perl gives complains this:
Bareword found where operator expected at -e line 1, near ""34233" protocol"
(Missing operator before protocol?)
Can't modify numeric lt (<) in scalar assignment at -e line 1, near ""34233" protocol"
syntax error at -e line 1, near ""34233" protocol"
Execution of -e aborted due to compilation errors.
could anyone help out here? would be very appreciate it.

You have to escape the forward slash before the 1.1 in your command (there tare two same thing in your command in fact). Because you are using / as regex delimiter.
\"HTTP\/1.1\"
^ here
Alternately you can use any different regex delimiter as well. For example using a hash:
s#..regex..#;;replace;;#g

Don't use regex to parse XML. It's nasty. Use a parser instead:
#!/usr/bin/env perl
use strict;
use warnings;
use XML::Twig;
my $twig = XML::Twig -> parsefile ( $ENV{'TOMCAT_SERVER_CONF'} );
foreach my $connector ( $twig -> get_xpath('Connector') ) {
$connector -> set_att('port', $ENV{'ACCESS_PORT'} );
}
$twig -> print;
If you need an in place edit:
#!/usr/bin/env perl
use strict;
use warnings;
use XML::Twig;
sub mod_connector {
my ( $twig, $connector ) = #_;
$connector->set_att( 'port', $ENV{'ACCESS_PORT'} );
}
my $twig = XML::Twig->new( twig_handlers => { 'Connector' => \&mod_connector } );
$twig -> parsefile_inplace( $ENV{'TOMCAT_ACCESS_CONF'} );
And if you really want a one liner:
perl -MXML::Twig -e 'XML::Twig->new( twig_handlers => { Connector => sub { $_->set_att( "port", $ENV{ACCESS_PORT} ) }})->parsefile_inplace( $ENV{TOMCAT_ACCESS_CONF} );'

Related

Perl - en / em dash in command line arguments

I'm having a problem with my perl script with parsing command line arguments. Mainly, I'd like perl to parse argument preceding with (em/en)-dash as well as hypen. Consider the following command execution:
my_spript.pl -firstParam someValue –secondParam someValue2
As you can see, firstParam is prefixed with hypen and there is no problem with perl parsing it, but the secondParam is prefixed with en-dash and unfortunately Perl cannot recognize it as an argument.
I am using GetOptions() to parse arguments:
GetOptions(
"firstParam" => \$firstParam,
"secondParam" => \$secondParam
)
If you're using Getopt::Long, you can preprocess the arguments before giving them to GetOptions:
#! /usr/bin/perl
use warnings;
use strict;
use Getopt::Long;
s/^\xe2\x80\x93/-/ for #ARGV;
GetOptions('firstParam:s' => \ my $first_param,
'secondParam:s' => \ my $second_param);
print "$first_param, $second_param\n";
It might be cleaner to first decode the arguments, though:
use Encode;
$_ = decode('UTF-8', $_), s/^\N{U+2013}/-/ for #ARGV;
To work in different locale setting, use Encode::Locale:
#! /usr/bin/perl
use warnings;
use strict;
use Encode::Locale;
use Encode;
use Getopt::Long;
$_ = decode(locale => $_), s/^\N{U+2013}/-/ for #ARGV;
GetOptions('firstParam:s' => \ my $first_param,
'secondParam:s' => \ my $second_param);
print "$first_param, $second_param\n";

How to refer GetOptions of special character?

I'm using GetOptions to act as a switch in my Perl code. I have an array that needs to be separated by a special character. Currently, I can write this following code.
&GetOptions('sep:i');
if ($opt_sep) {
$sep = "\.";
} else {
$sep = "\/";
}
When I try -sep 1, my output will be Flower.Red.Small. Without this statement or -sep 0 , my output will be Flower/Red/Small. Any idea how to exactly refer to any special character which user defined to separate my output statement? The separator may be any character of:
# # ^ * & % ; -
Are you asking for the following?
my #fields = split /\Q$opt_sep/, $str;
You can use s (string) instead of i (integer). Refer to Getopt::Long:
use warnings;
use strict;
use Getopt::Long qw(GetOptions);
my %opt = (sep => '/');
GetOptions(\%opt, 'sep=s');
my #stuff = qw(Flower Red Small);
print join($opt{sep}, #stuff), "\n";
__END__
script.pl -sep /
Flower/Red/Small
script.pl -sep .
Flower.Red.Small
script.pl -sep #
Flower#Red#Small

Using Perl to create another Perl file

I have an input file that looks like
*firsttitle
nameA
nameB
nameC
*secondtitle
xnameA
xnameB
xnameC
I want to create a Perl script that takes this file and basically will create another perl script that looks like
#!/usr/bin/perl
use strict;
use warnings;
my %tags = (
"firsttitle" => [ qw (nameA nameB nameC) ],
"secondtitle" => [ qw (xnameA xnameB xnameC) ]);
my $rx = join '|', keys %tags;
while (<>) {
s/^\s*($rx):\s*(\d+)/$1: $tags{$1}[$2]/;
print;
}
My thought process is that I have to first match print out the regular perl code (#!,use..etc.).Then add " my%tags=(. Then take the input file and look for the * and that's the lookup for the hash and start parsing everything after until the next(*) or end of life. If it's another * then do it again. If it's EOF then add ");" and end. And then finish with printing the last bit of perl code. Help/ideas would be appreciated. If you're going to post code snippets could you go through and explain what each part is doing? Thanks!
Very simple script. First just parse through the input file. Lines that start with * will be titles, and all the following lines up until the next *-line will be values. We put this into a hash of arrays.
The map statement gives us a list of the hash key (the title), and it's values joined together with space. We put this in an array for printing. The printing itself is done with printf, which can be a bit difficult to use, since meta characters will mess us up. Any % that are to be literal must be written as %%. I also changed single quotes from the original to double quotes. I use single quotes on the printf pattern to avoid accidental interpolation of variables.
An alternative - possibly better one - is to not just printf at all, and simply concatenate the string in a normal fashion.
use strict;
use warnings;
my ($title, %hash);
while (<DATA>) {
chomp;
if (/^\*(.+)$/) {
$title = $1;
} else {
push #{$hash{$title}}, $_;
}
}
my #args = ( map { $_, join(' ', #{$hash{$_}}) } keys %hash );
printf '#!/usr/bin/perl
use strict;
use warnings;
my %%tags = (
"%s" => [ qw ( %s ) ],
"%s" => [ qw ( %s ) ]);
my $rx = join "|", keys %%tags;
while (<>) {
s/^\s*($rx):\s*(\d+)/$1: $tags{$1}[$2]/;
print;
}', #args;
__DATA__
*firsttitle
nameA
nameB
nameC
*secondtitle
xnameA
xnameB
xnameC
Update:
This will use a different method of printing, which will be more stable.
my #args = ( map { " '$_' => [ qw ( #{$hash{$_}} ) ],\n" } keys %hash );
print '#!/usr/bin/perl
use strict;
use warnings;
my %tags = (
', #args, '
);
my $rx = join "|", keys %tags;
while (<>) {
s/^\s*($rx):\s*(\d+)/$1: $tags{$1}[$2]/;
print;
}';

Perl Module Method Calls: Can't call method "X" on an undefined value at ${SOMEFILE} line ${SOMELINE}

All over the place, especially in DBI, I see this message come up all the time. It's confusing, because the first thing that comes to mind is that the arguments I'm passing the function are set to undef (or something similar), but it's clearly not the case.
Given a module and a corresponding script...
Module: ./lib/My/Module.pm
package My::Module;
use strict;
use warnings;
sub trim {
my $str = shift;
$str =~ s{ \A \s+ }{}xms; # remove space from front of string
$str =~ s{ \s+ \z }{}xms; # remove space from end of string
return $str;
}
Script: ./test.pl
#!/usr/bin/perl
use strict;
use warnings;
use My::Module qw(trim);
print $My::Module->trim( " \t hello world\t \t" );
I get back the error message
Can't call method "trim" on an undefined value at ./text.pl line 7.
Infact, if I call $My::Module->notamethod( "hello world" ); it gives a similar error.
What's wrong with the above script/module?
What is that error Can't call method “X” on an undefined value at ${SOMEFILE} line ${SOMELINE} really saying?
Does this refer to the context of the method call (passed here to print), or the context of the arguments?
You're conflating several different ways to handle modules and objects - and ending up with one that doesn't work.
Here are four approaches that do work:
1/ My::Module is a library. trim is not exported.
$ cat My/Module.pm
package My::Module;
use strict;
use warnings;
sub trim {
my $str = shift;
$str =~ s{ \A \s+ }{}xms; # remove space from front of string
$str =~ s{ \s+ \z }{}xms; # remove space from end of string
return $str;
}
1;
$ cat test
#!/usr/bin/perl
use strict;
use warnings;
use My::Module;
# Note: No $ and :: not ->
print My::Module::trim( " \t hello world\t \t" );
2/ My::Module is a library. trim is exported.
$ cat My/Module.pm
package My::Module;
use strict;
use warnings;
use Exporter;
our #ISA = qw(Exporter);
our #EXPORT = qw(trim);
sub trim {
my $str = shift;
$str =~ s{ \A \s+ }{}xms; # remove space from front of string
$str =~ s{ \s+ \z }{}xms; # remove space from end of string
return $str;
}
1;
$ cat test
#!/usr/bin/perl
use strict;
use warnings;
use My::Module;
print trim( " \t hello world\t \t" );
3/ MyModule is a class. trim is a class method.
$ cat My/Module.pm
package My::Module;
use strict;
use warnings;
sub trim {
# Note class name passed as first argument
my $class = shift;
my $str = shift;
$str =~ s{ \A \s+ }{}xms; # remove space from front of string
$str =~ s{ \s+ \z }{}xms; # remove space from end of string
return $str;
}
1;
$ cat test
#!/usr/bin/perl
use strict;
use warnings;
use My::Module;
# Note: Not $ and -> not ::
print My::Module->trim( " \t hello world\t \t" );
4/ MyModule is a class, trim is an object method.
$ cat My/Module.pm
package My::Module;
use strict;
use warnings;
# Need a constructor (but this one does nothing useful)
sub new {
my $class = shift;
return bless {}, $class;
}
sub trim {
# Note: Object method is passed an object (which is ignored here)
my $self = shift;
my $str = shift;
$str =~ s{ \A \s+ }{}xms; # remove space from front of string
$str =~ s{ \s+ \z }{}xms; # remove space from end of string
return $str;
}
1;
$ cat test
#!/usr/bin/perl
use strict;
use warnings;
use My::Module;
my $trimmer = My::Module->new;
print $trimmer->trim( " \t hello world\t \t" );
I think that you were trying for option 1. In this case, I think I'd recommend option 2.
And to answer your final question. You are getting that error because you are trying to call a method on a variable ($My::Module) which is undefined.
That syntax is looking for an object or classname in the variable $My::Module and calling its trim method, but that variable is undefined.
Instead, you want to just say print My::Module::trim( " \t hello world\t \t" ); to call the My::Module::trim() function.
From the use line, it looks like you are trying to import trim() into the local package so you can just call it without the My::Module:: qualification, but your module doesn't look like it is set up to support exporting.
In your regexes, the /s and /m flags don't have any effect - they only change what ., ^, and $ match, and you don't use any of those.
It is just how Perl does OO. The difference is in between the way you call the methods.
This just calls the trim sub in the My::Module package:
My::Module::trim('foo')
On the other hand,
My::Module->trim('foo)
automatically becomes a call to the trim sub in the My::Module package with the string "My::Module" as the first argument.
Objects work the same way:
my $m = My::Module->new; # Corrected. Thanks for pointing this out.
$m->trim('foo');
Turns into a call to the same sub, but this time with a reference to the $m object as the first argument.
What you are trying to do is:
$My::Module->trim('foo');
Which translates to a dereference of the variable $My::Module (which does not exist), thus the error message "Can't call method X on an undefined value". If $My::Module were an actual reference to an object, this would result in a call to trim() on that object, with the reference as an implicit first argument.
Edit: Both commenters are correct. This answer was originally intended as a comment to the accepted answer. (Is there a way to fix that?)
Sorry for the confusion. I've added a little more detail here so hopefully it becomes more clear how it relates to the original question (dereferencing an undefined variable).

In Perl, how can I handle continuation lines in a configuration file?

So I'm trying to read in a config. file in Perl. The config file uses a trailing backslash to indicate a line continuation. For instance, the file might look like this:
=== somefile ===
foo=bar
x=this\
is\
a\
multiline statement.
I have code that reads in the file, and then processes the trailing backslash(es) to concatenate the lines. However, it looks like Perl already did it for me. For instance, the code:
open(fh, 'somefile');
#data = <fh>;
print join('', #data);
prints:
foo=bar
x=thisisamultiline statement
Lo and behold, the '#data = ;' statement appears to have already handled the trailing backslash!
Is this defined behavior in Perl?
I have no idea what you are seeing, but that is not valid Perl code and that is not a behavior in Perl. Here is some Perl code that does what you want:
#!/usr/bin/perl
use strict;
use warnings;
while (my $line = <DATA>) {
#collapse lines that end with \
while ($line =~ s/\\\n//) {
$line .= <DATA>;
}
print $line;
}
__DATA__
foo=bar
x=this\
is\
a\
multiline statement.
Note: If you are typing the file in on the commandline like this:
perl -ple 1 <<!
foo\
bar
baz
!
Then you are seeing the effect of your shell, not Perl. Consider the following counterexample:
printf 'foo\\\nbar\nbaz\n' | perl -ple 1
My ConfigReader::Simple module supports continuation lines in config files, and should handle your config if it's the format in your question.
If you want to see how to do it yourself, check out the source for that module. It's not a lot of code.
I don't know what exactly you are doing, but the code you gave us doesn't even run:
=> cat z.pl
#!/usr/bin/perl
fh = open('somefile', 'r');
#data = <fh>;
print join('', #data);
=> perl z.pl
Can't modify constant item in scalar assignment at z.pl line 2, near ");"
Execution of z.pl aborted due to compilation errors.
And if I change the snippet to be actual perl:
=> cat z.pl
#!/usr/bin/perl
open my $fh, '<', 'somefile';
my #data = <$fh>;
print join('', #data);
it clearly doesn't mangle the data:
=> perl z.pl
foo=bar
x=this\
is\
a\
multiline statement.