Access environment variable in perl written in double quotes via config file - perl

I have an environment variable $ROOT. For eg. $ROOT = "/someroot" It is accessed in a Perl file via config file parameters.
Eg
In config file :
path = '$ROOT/abc/somepath'
In Perl file while using this variable when I write config->{$path} in back ticks config->{$path} value of $ROOT is accessible i.e /someroot/abc/somepath but when in double quotes "config->{$path}" the result is $ROOT/abc/somepath.
I need this to be written in double quotes for opening files : open (filehandle,"config->{$path}"); How can achieve the value of config->{$path} in double quotes.
P.S I have also used $ENV{'config->{$path}'};

Try
my path = $ENV{"ROOT"} . config->{$path};
open(filehandle, path);
But now you do not have to precede your configured path with $ROOT.
config file: path = '/abc/somepath'

Are you looking for this?
sub get_conf {
my ($config, $key) = #_;
my $val = $config{key};
return undef if !defined($val);
$val =~ s{\$ROOT\b}{$ENV{ROOT}}g;
return $val;
}
my $path = get_conf(config, 'path');

For a more general solution, try one of the String::Interpolate modules on CPAN. I favor String::Interpolate::RE (disclaimer: I wrote it):
use String::Interpolate::RE 'strinterp';
my $path = strinterp( $config{path}, {}, { useENV=> 1 } );

Related

How to verify the name of a file?

I have a function that returns a file for the user avatar and I want to create tests for it. What I want to do is to check the name of the file.
This is the function:
sub get_avatar {
my $self = shift;
my $username = $self->stash('username');
my $home = Mojo::Home->new;
$home->detect('Project');
my $path = $home->child('users', 'avatars', "$username");
$path = $home->child('img', 'default.png') if !(-e $path);
$self->render_file('filepath' => $path);
}
And this is the test:
$file = $t->get_ok('/user/username/avatar')->status_is(200);
//use Data::Dumper;
//diag Dumper($file);
ok $file =~ 'username';
I want to check if the name of the $file is equivalent to 'username'(which is the name of the file from the server) or 'default' if it is a default avatar.
Don't work with the file path. Work with the actual image. Create two small test images. They can be 2x2 pixel PNG files. Maybe make them single colour, but different. Have one be your default one.
Then serialise that and put it in your test as a string. Run $t->tx->res->body through the same serialisation, and compare these two.
If you wanted, you could also make the test deploy that image before running the code, so your application doesn't depend on the image being there.

not able to give filename through a variable in XML::Excel

Not sure if there is any other way or something, but when i pass the filename as :
$excel_obj = XML::Excel->new();
$filename = "/tmp/"testresults-2013-07-01.xls"
$excel_obj->parse_doc("testresults-2013-07-01.xls" , {headings => 1});
it works, but if i pass :
$excel_obj->parse_doc("$filename" , {headings => 1});
it does not work
is there any special way to pass a filename through a variable....
When this happens you should try and print out your file name or use debugging mode.
This line seems to be wrong
$filename = "/tmp/"testresults-2013-07-01.xls"
You wither need to replace it with this
$filename = "/tmp/testresults-2013-07-01.xls"
removing the double quotes after /tmp/

How to debug Bugzilla extension that doesn't appear to run?

I need some help getting a bugzilla extension off the ground.
I want to hook into bug_format_comment (FWIW: to change some plain text automatically added as a comment when I commit to SVN to links to the respective SCM commit.)
Right now, nothing seems to happen when I manually add a comment to a bug.
Is there anything special I need to do to make the extension run, besides putting it in the /extensions/my-ext-name/ dir ?
How can I test if the extension is called at all?
I use an old version of Bugzilla (3.2.x). Is that hook even supported? (I can't find that info in the documentation).
Here's my complete Extension.pm file (I have no experience in Perl. I took the example of the hook from the example extension and ran from there)
package Bugzilla::Extension::Websvn-scmbug-autolink;
use strict;
use base qw(Bugzilla::Extension);
# This code for this is in ./extensions/Websvn-scmbug-autolink/lib/Util.pm
use Bugzilla::Extension::Websvn-scmbug-autolink::Util;
use URI::Escape;
our $VERSION = '0.01';
# See the documentation of Bugzilla::Hook ("perldoc Bugzilla::Hook"
# in the bugzilla directory) for a list of all available hooks.
sub install_update_db {
my ($self, $args) = #_;
}
sub bug_format_comment {
my ($self, $args) = #_;
my $regexes = $args->{'regexes'};
# push(#$regexes, { match => qr/\bfoo\b/, replace => 'bar' });
# 6665 --> 6666
# CTUFramework:trunk/CTUCsharpRuntime/CtuFramework/text1-renamed.txt
#my $bar_match = qr/\b(bar)\b/;
my $bar_match = qr/(?:^|\r|\n)(\d+|NONE) (-->) (\d+|NONE)[ \r\n\t]+([^:]+):(.*?)[\r\n]/s; #/s - treat as single line
push(#$regexes, { match => $bar_match, replace => \&_replace_bar });
my $scm_match2 = qr/(?:^|\r|\n)(\d+|NONE) (-->) (\d+|NONE)[ \r\n\t]+([^:]+):(.*?)[\r\n]/s; #/s - treat as single line
push(#$regexes, { match => $scm_match2, replace => \&_replace_bar });
}
# Used by bug_format_comment--see its code for an explanation.
sub _replace_bar {
my $args = shift;
my $scmFromVer = $args->{matches}->[0];
my $scmToVer = $args->{matches}->[1];
my $scmArrow = $args->{matches}->[2];
my $scmProject = $args->{matches}->[3];
my $scmFile = $args->{matches}->[4];
# Remember, you have to HTML-escape any data that you are returning!
my $websvnRoot = "http://devlinux/websvn";
my $websvnRepo = uri_escape($scmProject); #maybe do a mapping
my $websvnFilePath = uri_escape("/".$scmFile);
my $fromRevUrl = sprintf("%s/revision.php?repname=%s&rev=%s",
$websvnRoot, $websvnRepo, $scmFromVer);
my $toRevUrl = sprintf("%s/revision.php?repname=%s&rev=%s",
$websvnRoot, $websvnRepo, $scmToVer);
my $diffUrl = sprintf("%s/diff.php?repname=%s&path=%s&rev=%s",
$websvnRoot, $websvnRepo, $websvnFilePath, $scmToVer);
my $fileUrl = sprintf("%s/filedetails.php?repname=%s&path=%s&rev=%s",
$websvnRoot, $websvnRepo, $websvnFilePath, $scmToVer);
# TODO no link for 'NONE'
my $fromRevLink = sprintf(qq{%s}, $fromRevUrl, $scmFromVer);
my $toRevLink = sprintf(qq{%s}, $toRevUrl, $scmToVer);
my $diffLink = sprintf(qq{%s}, $diffUrl, $scmArrow);
my $fileLink = sprintf(qq{%s}, $fileUrl, $scmFilePath);
# $match = html_quote($match);
return "$fromRevLink $diffLink $toRevLink:$fileLink";
};
__PACKAGE__->NAME;
As written, your extension won't even load: dashes are not valid in Perl package names.
Change the name from Websvn-scmbug-autolink to Websvn_scmbug_autolink.
I searched the Bugzilla sources, and found that the hook is simply not supported in version 3.2.x. The hook was introduced in Bugzilla 3.6: http://bzr.mozilla.org/bugzilla/3.6/revision/6762
PS. I hacked the regex replaces right in the template script for comments. Hacky, but it works.

Could not open file perl

I am trying to convert a plist files into a JUnit style XMLs. I have a xsl stylesheet which converts the plist to JUnit/ANT XML.
Here is the perl code which I run to convert the plist to XML:
my $parser = XML::LibXML->new();
my $xslt = XML::LibXSLT->new();
my $stylesheet = $xslt->parse_stylesheet_file("\\\~/Hudson/build/workspace/ui-automation/automation\\\ test\\\ suite/plist2junit.xsl");
my $counter = 1;
my #plistFiles = glob('Logs/*/*.plist');
foreach (#plistFiles){
#Escape the file path and specify abosulte path
my $plistFile = $_;
$plistFile =~ s/([ ()])/\\$1/g;
$path2plist = "\\\~/Hudson/build/workspace/ui-automation/automation\\\ test\\\ suite/$plistFile";
#transform the plist file to xml
my $source = $parser->parse_file($path2plist);
my $results = $stylesheet->transform($source);
my $resultsFile = "\\\~/Hudson/build/workspace/ui-automation/automation\\\ test\\\ suite/JUnit/results$counter.xml";
#create the output file
unless(open FILE, '>'.$resultsFile) {
# Die with error message
die "\nUnable to create $file\n";
}
# Write results to the file.
$stylesheet->output_file($results, FILE);
close FILE;
$counter++;
}
After running the perl script on Hudson/Jenkins, it outputs this error message:
Couldn't open ~/Hudson/build/workspace/ui-automation/automation\ test\ suite/Logs/Run\ 1/Automation\ Results.plist: No such
file or directory
The error is caused by my $source = $parser->parse_file($path2plist); in the code. I am unable to figure out why it cannot find/read the file.
Anyone know what might be causing the error?
There are three obvious error in the path mentioned in the error message.
~/Hudson/build/workspace/ui-automation/automation\ test\ suite/Logs/Run\ 1/Automation\ Results.plist
Those are:
There's no directory named ~ in the current directory. Perhaps you meant to use the value of $ENV{HOME} there?
There's no directory named automation\ test\ suite anywhere on your disk, but there is probably one named automation test suite.
Similarly, there's no directory named Run\ 1 anywhere on your disk, but there is probably one named Run 1.

What does this perl crash means?

Can someone tell me what this means?
if (not defined $config{'crontab'}) {
die "no crontab defined!";
}
I want to open a file crontab.txt but the perl script crashes at this line and I don't really know any perl.
EDIT 1
It goes like this:
sub main()
{
my %config = %{getCommandLineOptions()};
my $programdir = File::Spec->canonpath ( (fileparse ( Win32::GetFullPathName($PROGRAM_NAME) ))[1] );
my $logdir = File::Spec->catdir ($programdir, 'logs');
$logfile = File::Spec->catfile ($logdir, 'cronw.log');
configureLogger($logfile);
$log = get_logger("cronw::cronService-pl");
# if --exec option supplied, we are being invoked to execute a job
if ($config{exec}) {
execJob(decodeArgs($config{exec}), decodeArgs($config{args}));
return;
}
my $cronfile = $config{'crontab'};
$log->info('starting service');
$log->debug('programdir: '.$programdir);
$log->debug('logfile: '.$logfile);
if (not defined $config{'crontab'}) {
$log->error("no crontab defined!\n");
die "no crontab defined!";
# fixme: crontab detection?
}
$log->debug('crontab: '.$config{'crontab'});
And I'm trying to load this 'crontab.txt' file...
sub getCommandLineOptions()
{
my $clParser = new Getopt::Long::Parser config => ["gnu_getopt", "pass_through"];
my %config = ();
my #parameter = ( 'crontab|cronfile=s',
'exec=s',
'args=s',
'v|verbose'
);
$clParser->getoptions (\%config, #parameter);
if (scalar (#ARGV) != 0) { $config{'unknownParameter'} = $true; }
return \%config;
}
Probably I have to give the script an argument
Probably I have to give the script an argument
I would say so.
$ script --cronfile=somefile
That code looks to see whether there is a key 'crontab' in the hash %config. If not, then it calls die and terminates.
If that's not what you expect to happen, then somewhere else in your script there should be something that is setting $config{'crontab'}, but there is not currently enough information in your question to determine what that might be.
Probably the file path of crontab.txt is expected in %config hash, pointed by the 'crontab' key, but isn't there! If so, a DIRTY solution CAN BE:
$config{'crontab'}='FULLPATH/crontab.txt';
#if (not defined $config{'crontab'}) {
# die "no crontab defined!";
#}
but this may not work because there is something like $config{'prefix'} and what you will try to open is the path represented by the concatenation of both, or just because in $config{'crontab'} is expected any other value than full path!