I am using Path::Class::Rule for getting absolute path of required file .
As my file name either have UILogs[_d]* or log.main format. Below is the code which i am using
Code :
use warnings;
BEGIN {
eval { require Path::Class::Rule }
or system("ppm install Path::Class::Rule");
}
use Path::Class;
use Path::Class::Rule;
use Cwd qw();
use File::Path qw(make_path);
use File::Copy;
my $root = "logpath";
my #uiLogDirs = grep { -d $_ && !/A\.\.?\z/ } dir($root)->children();
my $iter = Path::Class::Rule->new->file->name(qr/ UILogs[_d]* | log.main/)->iter(#uiLogDirs);
while ( my $uifilepath = $iter->() ) {
print "$uifilepath\n";
}
But above code is not working i.e unable to search the file. It is working fine if i am using
my $iter = Path::Class::Rule->new->file->name(qr/log.main/)->iter(#uiLogDirs);
Logs file Example:
Monkey_SDCard_UILogs_141008_154230
log.main
Can anyone help me out in the above issue?
Spaces are significant in regular expressions unless you use the /x modifier:
qr/UILogs[_d]*|log\.main/
qr/ UILogs[_d]* | log\.main /x
BTW, I'm not sure about the first alternative. Do you really have filenames like UILogs___d_?
Related
I am using more modules in my perl program.
example:
use File::copy;
so likewise File module contains Basename, Path, stat and etc..
i want to list all the subroutine(function) names which is in File Package module.
In python has dir(modulename)
It list all the function that used in that module....
example:
#!/usr/bin/python
# Import built-in module math
import math
content = dir(math)
print content
Like python tell any code for in perl
If you want to look at the contents of a namespace in perl, you can use %modulename::.
For main that's either %main:: or %::.
E.g.:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
sub fish {};
sub carrot {};
print "Stuff defined in Dumper:\n";
print Dumper \%Data::Dumper::;
print "Stuff defined:\n";
print Dumper \%::;
That covers a load of stuff though - including pragmas. But you can check for e.g. subroutines by simply testing it for being a code reference.
foreach my $thing ( keys %:: ) {
if ( defined &$thing ) {
print "sub $thing\n";
}
}
And with reference to the above sample, this prints:
sub Dumper
sub carrot
sub fish
So with reference to your original question:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use File::Copy;
print "File::Copy has subs of:\n";
foreach my $thing ( keys %File::Copy:: ) {
if ( defined &$thing ) {
print "sub $thing\n";
}
}
Unfortunately you can't do the same thing with the whole File:: namespace, because there's a whole bunch of different modules that could be installed/loaded, but might not be.
You'd have to use e.g. CPAN to check that -
perl -MCPAN -e shell
i /^File::/
Which will list you around 717 modules that are grouped into the File:: tree.
You could look this up on CPAN. Or if you're just after the core modules, then some variant of using Module::CoreList might do what you want.
Something like this:
#!/usr/bin/perl
use strict;
use warnings;
use Module::CoreList;
foreach my $module ( Module::CoreList->find_modules(qr/^File::/) ) {
if ( eval { require $module =~ s|::|/|gr . ".pm" } ) {
print "Module: $module contains\n";
my $key_str = "\%$module\:\:";
my %stuff = eval $key_str;
foreach my $thing ( sort keys %stuff ) {
my $full_sub_path = "$module::$thing";
if ( eval {"defined &$full_sub_path"} ) {
if ( defined &$thing ) {
print "$thing <- $full_sub_path imported by default\n";
}
else {
print "\t$full_sub_path might be loadable\n";
}
}
}
}
else {
print "Module: $module couldn't be loaded\n";
}
}
It's a bit messy because you have to eval various bits of it to test if a module is in fact present and loadable at runtime. Oddly enough, File::Spec::VMS wasn't present on my Win32 system. Can't think why.... :).
Should note - just because you could import a sub from a module (that isn't exported by default) doesn't make it a good idea. By convention, any sub prefixed with an _ is not supposed to be used externally, etc.
My Devel::Examine::Subs module can do this, plus much more. Note that whether it's a method or function is irrelevant, it'll catch both. It works purely on subroutines as found with PPI.
use warnings;
use strict;
use Devel::Examine::Subs;
my $des = Devel::Examine::Subs->new;
my $subs = $des->module(module => 'File::Copy');
for (#$subs){
print "$_\n";
}
Output:
_move
move
syscopy
carp
mv
_eq
_catname
cp
copy
croak
Or a file/full directory. For all Perl files in a directory (recursively), just pass the dir to file param without a file at the end of the path:
my $des = Devel::Examine::Subs->new(file => '/path/to/file.pm');
my $subs = $des->all;
If you just want to print it use the Data::Dumper module and the following method, CGI used as an example:
use strict;
use warnings;
use CGI;
use Data::Dumper;
my $object = CGI->new();
{
no strict 'refs';
print "Instance METHOD IS " . Dumper( \%{ref ($object)."::" }) ;
}
Also note, it's File::Copy, not File::copy.
I have written a perl script where I will be connecting to database, for which I'm using this statement
my $dbh = DBI->connect(
"DBI:mysql:database=test;host=localhost;mysql_socket=/var/run/mysqld/mysqld.sock",
"root", "password", {'RaiseError' => 1});
As I don't want any information to be hardcoded, I want to use properties file where I can list the above details (e.g., database, host, mysql_socket) and read the details of properties file from the script. How can I write the properties file and read the details from perl script?
There are a lot of CPAN modules that helps you to achieve this task.
I like Config::Simple, for example:
#!/usr/bin/perl
use strict;
use warnings;
use Config::Simple;
...
my $cfg = new Config::Simple('myapp.ini');
my $user = $cfg->param('database.user');
my $connection_str = $cfg->param('database.connection');
#...
and the file myapp.ini:
[database]
connection="DBI:mysql:database=test;host=localhost;mysql_socket=/var/run/mysqld/mysqld.sock"
user=root
;...
You can install the module from the terminal/command prompt using:
cpan install Config::Simple
or
yum install perl-Config-Simple
I had issues using perl-Config-Simple and decided to use Config::Properties instead. If you are experiencing the same, then you can try the following.
Make sure you have the Config::Properties installed. The following are several examples of how to install from command line, depending on the OS you are using, you'll want to use the appropriate choice:
cpan Config::Properties
cpan install Config::Properties
yum install perl-Config-Properties
The code:
#!/usr/bin/perl
use strict;
use warnings;
use Config::Properties;
open my $cfh, '<', './foo.properties' or die "unable to open property file";
my $properties = Config::Properties->new();
$properties->load($cfh);
my $dbName = $properties->getProperty('database.name');
my $dbUser = $properties->getProperty('database.user');
The property file:
database.name=somedb
database.user=someuser
Once you have the values in the variables, put them into your connection string and you should be good to go.
var temp;
if($ENV eq "Prod"){
#Prod Configurations
temp = "Prod";
}
else{
# Stage and Test Confgurations
temp = "Stage";
}
My brick and mortar solution, exports one value from a properties file:
#!/usr/bin/perl
use strict;
use warnings;
my $line;
foreach $line (<STDIN>) {
chomp($line);
if(my $match = $line =~ /^(.*)=(.*)$/){
my $key = $1;
my $value = $2;
if ($ARGV[0] eq $key) {
print "$value\n";
exit 0;
}
}
}
Usage: perl script.pl mykey < file.properties
Try to debug this script. I think it maybe an issue of variable interpolation? I'm not sure.
It works using options if I pass the values like so:
perl test-file-exists.pl --file /proj/Output/20111126/_GOOD
I am trying to remove the option of passing in --file since I need to generate the date
dynamically.
perl test-file-exists.pl
Given the code changes below (I commented out the options piece). I am trying to create the string (see $chkfil). I am getting errors passing in $dt4. Somehow, its not passing in the file string that I am creating into this other module.
use strict;
use warnings;
use lib '/home/test/lib';
use ProxyCmd;
use Getopt::Long;
#
### Set up for Getopt
#
#my $chkfil;
#my $help;
#usage() if ( #ARGV < 1 or
# ! GetOptions('help|?' => \$help,
# 'file=s' => \$chkfil)
# or defined $help );
my $cmd = ProxyCmd->new( User=>"test_acct",
AuthToken=>"YToken",
loginServer=>"host.com");
# Get previous day
my $dt4 = qx {date --date='-1day' +'%Y%m%d'};
# Check file
my $chkfil = qq{/proj/Output/$dt4/_GOOD};
# Now test the fileExists function
print "Checking 'fileExists':\n";
my $feResults = $cmd->fileExists("$chkfil");
if ($feResults == 0) {
print "File Exists!\n";
} else {
print "File Does Not Exist\n";
}
sub usage
{
print "Unknown option: #_\n" if ( #_ );
print "usage: program [--file /proj/Output/20111126/_GOOD] [--help|-?]\n";
exit;
}
When you use backticks or qx, you get the trailing newline included so chomp it off:
my $dt4 = qx {date --date='-1day' +'%Y%m%d'};
chomp $dt4;
and you'll get a sensible filename.
You could also use DateTime and friends to avoid shelling out entirely.
I'm trying to find the comment # VERSION in a perl source file. I then want to insert the version before the comment (or in place of doesn't matter). Could anyone tell me the right way to do this with PPI?
before
use strict;
use warnings;
package My::Package;
# VERSION
...
after
use strict;
use warnings;
package My::Package;
our $VERSION = 0.1;# VERSION
...
maintaining the # VERSION in the end result is optional
I actually have a couple of ideas on how to find # VERSION but one is a regex of a serialized ppi doc which doesn't seem right, and the other is using find_first on a Comment but if it's not the first I'm not sure what to do.
Updated code This seems closer to a correct solution since it only looks at the comments. but I'm not sure how to use or really how to create a new variable.
#!/usr/bin/env perl
use 5.012;
use strict;
use warnings;
use PPI;
my $ppi = PPI::Document->new('test.pm');
my $comments = $ppi->find('PPI::Token::Comment');
my $version = PPI::Statement::Variable->new;
foreach ( #{$comments} ) {
if ( /^\s*#\s+VERSION\b$/ ) {
$_->replace($version);
}
}
UPDATE
The answer to this question became the foundation for DZP::OurPkgVersion
Here's some code that does something like what you describe - It'll get you started anyway. It's edited from Catalyst::Helper::AuthDBIC (source), which is a full example of working with PPI (although bits of it may not be best practices):
sub make_model {
### snip some stuff
my $module = "lib/$user_schema_path.pm";
my $doc = PPI::Document->new($module);
my $digest_code = # some code
my $comments = $doc->find(
sub { $_[1]->isa('PPI::Token::Comment')}
);
my $last_comment = $comments->[$#{$comments}];
$last_comment->set_content($digest_code);
$doc->save($module);
}
I suppose in your case you grab the $comments arrayref and modify the first item that matches /VERSION/ with the replacement content.
And here's the final code courtesy of the poster:
#!/usr/bin/env perl
use 5.012;
use warnings;
use PPI;
my $ppi = PPI::Document->new('test.pm');
my $comments = $ppi->find('PPI::Token::Comment');
my $version = 0.01;
my $_;
foreach ( #{$comments} ) {
if ( /^(\s*)(#\s+VERSION\b)$/ ) {
my $code = "$1" . 'our $VERSION = ' . "$version;$2\n";
$_->set_content("$code");
}
}
$ppi->save('test1.pm');
Following code always print paths with double slashes:
use JSON;
use File::Spec;
my $installdir = $ENV{"ProgramFiles"};
my $xptrlc = File::Spec->catfile($installdir,"bin","sample");
my $jobhash;
my $return_packet;
$jobhash->{'PATH'} = $xptrlc;
$return_packet->{'JOB'} = $jobhash;
my $js = new JSON;
my $str = $js->objToJson($return_packet);
print STDERR "===> $str \n";
OUTPUT of this script is
===> {"JOB":{"PATH":"C:\\Program Files (x86)\\bin\\sample"}}
Any solution to remove those double \\ slashes?
As Greg mentioned, the '\' character is represented as '\\' in JSON.
http://www.ietf.org/rfc/rfc4627.txt?number=4627
If you intend to use "thaw" the JSON somewhere, like in another Perl program or in JavaScript, you will still get back exactly what you put in.
Are you trying to do something else with your JSON?
Windows is perfectly fine with using '/' in paths if that bothers you so much:
use strict; use warnings;
use JSON;
use File::Spec::Functions qw(catfile);
my $installdir = $ENV{ProgramFiles};
my $xptrlc = catfile $installdir,qw(bin sample);
$xptrlc =~ s'\\'/'g;
my $packet = { JOB => { PATH => $xptrlc } };
my $js = JSON->new;
my $str = $js->encode($packet);
warn "===> $str \n";
Output:
===> {"JOB":{"PATH":"C:/Program Files/bin/sample"}}
On the other hand, the encoded value will be correctly decoded:
use JSON;
warn JSON->new->decode(scalar <DATA>)->{JOB}->{PATH}, "\n";
__DATA__
{"JOB":{"PATH":"C:\\Program Files (x86)\\bin\\sample"}}
Output:
C:\Temp> ht
C:\Program Files (x86)\bin\sample