I am trying to use Perl on windows. I am think I am having a problem either with syntax or with access to CPAN information. What information I can find gives snippets on how to use the functions and when I try to use the examples I get errors.
I do not know how to get to CPAN. I tried to install it and it failed twice on GCC and dmake. I do not know if that would help or not. I used http://www.cpan.org/modules/INSTALL.html cpan App::cpanminus
I have a filename with the path ex:
c:\users\me\directory\\*.* This file contains a list of path+filename records for which I need the time and size of the file. When I read a record I can verify that the path+filename is correct.
I have had some help doing this in a batch file. I was using %~t1 and %~z1 as shown here:
pass the full path to the batch file then use
if "%~t1" == "" (
echo " AN ERROR OCURRED FOR THIS FILE/n"
) else (
echo fpath =%~1
echo time = %~t1
echo size = %~z1
)
When I tried to bring this over to Perl I can not get it to work. I have run out of hints and ideas to try.
I have tried to use a similar IF ( "%~t1" == "" ) {} but I get (missing operator before t1?).
I tried to use my $str1 = %~t1 and got "str1" not allowed while "strict subs" in use.
I tried to use $info->$ctime and got requires explicit package name.
I tried my $modtime = (stat($dirHandle))[9] with print "mod time = $mod_time \n"; and got no such class mod_time and syntax error.
I tried using the following I got from a perl programing documentation file for perl 5.20.1
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat($filename);
I could not see how that would work and it did not. I got a lot of requires explicit package name
I tried this from the same reference
use File::stat;
$sb = stat($filename);
printf "File is %s, size is %s, perm %04o, mtime %s\n",
$filename, $sb->size, $sb->mode & 07777,
scalar localtime $sb->mtime;
I can not remember all the errors
Every time I see File::stat or Path::Class::File I do not know how to get any of these.
The perl monks are a little over my head as far as getting answers. I get lost in all the what ifs.
Thanks for any help you can give me.
Sounds like you're asking how to get the size and the last-modified time of a file.
Using stat:
use POSIX qw( strftime );
my $qfn = 'c:\\users\\me\\directory\\file';
my ($size, $mtime) = (stat($qfn))[7, 9]
or die("Can't stat \"$qfn\": $!\n");
printf("File %s: size=%s modified=%s\n",
$qfn,
$size,
strftime("%Y-%m-%d %H:%M:%S", localtime($mtime)),
);
Using File::stat, which replaces stat with a function with a friendlier interface:
use File::stat qw( stat );
use POSIX qw( strftime );
my $qfn = 'c:\\users\\me\\directory\\file';
my $stat = stat($qfn)
or die("Can't stat \"$qfn\": $!\n");
printf("File %s: size=%s modified=%s\n",
$qfn,
$stat->size,
strftime("%Y-%m-%d %H:%M:%S", localtime($stat->mtime)),
);
Both modules mentioned come with Perl. No need to install them.
Related
Below is the Perl code in .pm file which is supposed to replace the specified strings (that are in "quotes") with some values. But its not happening. Can anyone explain what is happening in this code?
package SomePackage;
require Exporter;
#ISA = qw(Exporter);
#EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
sub send_request {
my ( $service, $action, $torole ) = #_;
my ( $seller_request_mmd );
my $replace_contents = ();
$replace_contents{"REPLACE_Service"} = $service;
$replace_contents{"REPLACE_RequestAction"} = $action;
$replace_contents{"REPLACE_TradingPartner"} = $torole;
$replace_contents{"REPLACE_Requestxml"} = "Request.xml";
create_mmd_and_transfer( \%replace_contents, $seller_request_mmd, "/MMD.xml" );
}
sub create_mmd_and_transfer {
my $local_replace_contents = shift;
my $input_mmd = shift;
my $local_output_mmd = shift;
my $output_mmd = shift;
update_mmd_file( "$input_mmd", "temp_mmd_file.xml", $local_replace_contents );
}
sub update_mmd_file {
my $input_file = shift;
my $output_file = shift;
my $contents = shift;
open( MMD_FILE, "<$input_file" )
or main::error_exit(" Cannot open MMD file template $input_file \n $input_file not found int the Templates folder \n Please place the same and then run the script ");
open( TEMP_MMD_FILE, ">$output_file" );
while ( <MMD_FILE> ) {
s/^M//g; # Getrid of the ^Ms
foreach my $content ( keys( %$contents ) ) {
my $exact_value = ${%$contents}{$content};
if ( $main::test_scenario =~ /^Invalid Request Action \a\n\d Service/
and ( $content =~ /REPLACE_Service|REPLACE_RequestAction/i ) ) {
}
else {
if ( $exact_value ne "" ) {
s/$content/$exact_value/g;
}
}
}
print TEMP_MMD_FILE;
}
close MMD_FILE;
close TEMP_MMD_FILE;
}
The following will not make your script work, just create the better base for some future questions.
Before you even thinking about posting a perl question here:
1.) add to the top of your script:
use strict;
use warnings;
Posting a code here without these two lines, nobody will bother even trying to read the code.
2.) use perl -c SomePackage.pm for the check. If it will tell you: SomePackage.pm syntax OK - you can start thinking about posting a question here. ;)
Some basic problems with your script:
package SomePackage;
use strict; # see the above
use warnings;
require Exporter;
# these variables are defined outside of this package, so, tell perl this fact. use the `our`
our #ISA = qw(Exporter);
#the use warnings will warn you about the following line
# #EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
#the correct one is without commas
our #EXPORT = qw(send_request create_mmd_and_transfer update_mmd_file); #not saying anything about the #EXPORT rudeness. :)
#my $replace_contents = ();
#the $replace_contents is a scalar. Bellow you using a hash. So,
my %replace_contents;
#or use the scalar but the lines bellow should use the hashref notation, e.g.
# $replace_contents->{"REPLACE_Service"} = $service;
# you decide. :)
# the seller_request_mmd contains undef here.
create_mmd_and_transfer( \%replace_contents, $seller_request_mmd, "/MMD.xml");
# also bellow, in the subroutine definition it wants 4 arguments.
# indicates a problem...
# using 2-arg open is not the best practice.
# Also, you should to use lexical filehandles
# open (MMD_FILE, "<$input_file")
# better
open (my $mmd_file, '<', $input_file)
# of course, you need change every MMD_FILE to $mmd_file
# check the result of the open and die if not successful
# or you can use the
use autodie;
# instead of $exact_value = ${%$contents}{$content};
# you probably want
my $exact_value = $contents->{$content};
Indent your code!
All the above are just about the syntactic problems and not solving anything about the "logic" of your code.
Ps: And me is still an beginner, so, others sure will find much more problems with the above code.
Ok. Here's what I've done to test this.
Firstly, you didn't give us an input file or the code that you use to call the module. So I invented them. I made the simplest possible input file:
REPLACE_Service
REPLACE_RequestAction
REPLACE_TradingPartner
REPLACE_Requestxml
And this driver program:
#!/usr/bin/perl
use strict;
use warnings;
use SomePackage;
send_request('foo', 'bar', 'baz');
sub error_exit {
die #_;
}
The first time, I ran it, I got this error:
Undefined subroutine &main::send_request called at test line 8.
That was because your #EXPORT line was wrong. You had:
#EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
But the point of qw(...) is that you don't need the commas. So I corrected it to:
#EXPORT = qw(send_request create_mmd_and_transfer update_mmd_file);
Then I re-ran the program and got this error:
Cannot open MMD file template
not found int the Templates folder
Please place the same and then run the script at test line 11.
That looked like there was something missing. I changed the error message, adding indicators of where the variable interpolation was supposed to happen:
open( MMD_FILE, "<$input_file" )
or main::error_exit(" Cannot open MMD file template <$input_file> \n <$input_file> not found int the Templates folder \n Please place the same and then run the script ");
Then the error message looked like this:
Cannot open MMD file template <>
<> not found int the Templates folder
Please place the same and then run the script at test line 11.
So it seems clear that the $input_file variable isn't set in the update_mmd_file() subroutine. Tracing that variable back, we see that this value is originally the $seller_request_mmd variable in send_request(). But in send_request() you declare $seller_request_mmd but you never give it a value. So let's do that:
my ( $seller_request_mmd ) = 'test_input.txt';
Now, when I run your program, it runs to completion without any errors. And I find a new temp_mmd_file.xml is generated. But it is exactly the same as the input file. So more investigation is needed.
Digging into the update_mmd_file() subroutine, we find this interesting line:
my $exact_value = ${%$contents}{$content};
I think you're trying to extract a value from $contents, which is a hash reference. But your syntax is wrong. You were probably aiming at:
my $exact_value = ${$contents}{$content};
But most Perl programmers prefer the arrow notation for working with reference look-ups.
my $exact_value = $contents->{$content};
Making that change and re-running the program, I get an output file that contains:
foo
bar
baz
Request.xml
Which is exactly what I expected. So the program now works.
But there is still a lot of work to do. As you have been told repeatedly, you should always add:
use strict;
use warnings;
to your code. That will find a lot of potential problems in your code - which you should fix.
To be honest, this feels to me like you were trying to run before you could walk. I'd recommend spending some time to work through a good Perl introductory book before taking on my more Perl work.
And there was a lot of useful information missing from your question. It wouldn't have taken as long to get to the solution if you had shown us your driver program and your input data.
For example, given an empty file テスト.txt, how would I make a copy called テスト.txt.copy?
My first crack at it managed to access the file and create the new filename, but the copy generated テスト.txt.copy.
Here was my first crack at it:
#!/usr/bin/env perl
use strict;
use warnings;
use English '-no_match_vars';
use File::Basename;
use Getopt::Long;
use File::Copy;
use Win32;
my (
$output_relfilepath,
) = process_command_line();
open my $fh, '>', $output_relfilepath or die $!;
binmode $fh, ':utf8';
foreach my $short_basename ( glob( '*.txt') ) {
# skip the output basename if it's in the glob
if ( $short_basename eq $output_relfilepath ) {
next;
}
my $long_basename = Win32::GetLongPathName( $short_basename );
my $new_basename = $long_basename . '.copy';
print {$fh} sprintf(
"short_basename = (%s)\n" .
" long_basename = (%s)\n" .
" new_basename = (%s)\n",
$short_basename,
$long_basename,
$new_basename,
);
copy( $short_basename, $new_basename );
}
printf(
"\n%s done! (%d seconds elapsed)\n",
basename( $0 ),
time() - $BASETIME,
);
# === subroutines ===
sub process_command_line {
# default arguments
my %args
= (
output_relfilepath => 'output.txt',
);
GetOptions(
'help' => sub { print usage(); exit },
'output_relfilepath=s' => \$args{output_relfilepath},
);
return (
$args{output_relfilepath},
);
}
sub usage {
my $script_name = basename $0;
my $usage = <<END_USAGE;
======================================================================
Test script to copy files with a UTF-8 filenames to files with
different UTF-8 filenames. This example tries to make copies of all
.txt files with versions that end in .txt.copy.
usage: ${script_name} (<options>)
options:
-output_relfilepath <s> set the output relative file path to <s>.
this file contains the short, long, and
new basenames.
(default: 'output.txt')
----------------------------------------------------------------------
examples:
${script_name}
======================================================================
END_USAGE
return $usage;
}
Here are the contents of output.txt after execution:
short_basename = (BD9A~1.TXT)
long_basename = (テスト.txt)
new_basename = (テスト.txt.copy)
I've tried replacing File::Copy's copy command with a system call:
my $cmd = "copy \"${short_basename}\" \"${new_basename}\"";
print `$cmd`;
and with Win32::CopyFile:
Win32::CopyFile( $short_basename, $new_basename, 'true' );
Unfortunately, I get the same result in both cases (テスト.txt.copy). For the system call, the print shows 1 file(s) copied. as expected.
Notes:
I'm running Perl 5.10.0 via Strawberry Perl on Windows 7 Professional
I use the Win32 module to access long filenames
The glob returns short filenames, which I have to use to access the file
テスト = test (tesuto) in katakana
I've read perlunitut and The Absolute Minimum Every Software Developer Absolutely, Positively Must Know About Unicode and Character Sets (No Excuses!)
This should be possible with the CopyFileW function from Win32API::File, which should be included with Strawberry. I've never messed with Unicode filenames myself, so I'm not sure of the details. You might need to use Encode to manually convert the filename to UTF-16LE (encode('UTF16-LE', $filename)).
You're getting the long filename using Win32, which gives you a UTF-8-encoded string.
However, you're then setting the long filename using plain copy, which uses the C stdlib IO functions. The stdlib functions use the default filesystem encoding.
On modern Linuxes that's usually UTF-8, but on Windows it (sadly) never is, because the system default code page cannot be set to UTF-8. So you'll get your UTF-8 string interpreted as a code page 1252 string on a Western European Windows install, as has happened here. (On a Japanese machine it'd get interpreted as code page 932 — like Shift-JIS — which would come out something like 繝�せ繝�.)
I've not done this in Perl, but I'd suspect the Win32::CopyFile function would be more likely to be able to handle the kind of Unicode paths returned elsewhere in the Win32 module.
Use Encode::Locale:
use Encode::Locale;
use Encode;
use File::Copy;
copy( encode(locale_fs => $short_basename),
encode(locale_fs => $new_basename) ) || die $!;
I successfully duplicated your problem on my Windows machine (Win XP Simplified Chinese version) and my conclusion is that the problem is caused by the font. Choose a Truetype font rather than Raster fonts and see if everything is okay.
My experiment is this:
I first changed the code page of my Windows Console from the default 936 (GBK) to 65001 (UTF-8).
by typing C:>chcp 65001
I wrote a scrip that contains the code: $a= "テスト"; print $a; and saved it as UTF-8.
I ran the script from the Console and found "テスト" became "テスト", which is exactly the same sympton you described in your question.
I changed the Console Font from Raster Fonts to Lucida Console, the console screen gave me this: "テストストトト", which is still not quite right but I assume it is getting closer to the core of the problem.
So althought I'm not 100% sure but the problem is probably caused by the font.
Hope this helps.
See https://metacpan.org/pod/Win32::Unicode
#!/usr/bin/perl --
use utf8;
use strict;
use warnings;
my #kebabs = (
"\x{45B}\x{435}\x{432}\x{430}\x{43F}.txt", ## ћевап.txt
"ra\x{17E}nji\x{107}.txt", ## ražnjić.txt
"\x{107}evap.txt", ## ćevap.txt
"\x{43A}\x{435}\x{431}\x{430}\x{43F}\x{447}\x{435}.txt", ## кебапче.txt
"kebab.txt",
);
{
use Win32::Unicode qw/ -native /;
printW "I \x{2665} Perl"; # unicode console out
mkpathW 'meat';
chdirW 'meat';
for my $kebab ( #kebabs ){
printW "kebabing the $kebab\n";
open my($fh), '>:raw', $kebab or dieW Fudge($kebab);
print $fh $kebab or dieW Fudge($kebab);
close $fh or dieW Fudge($kebab);
}
}
sub Fudge {
use Errno();
join qq/\n/,
"Error #_",
map { " $_" } int( $! ) . q/ / . $!,
int( $^E ) . q/ / . $^E,
grep( { $!{$_} } keys %! ),
q/ /;
}
Some time ago, I ask a question: How do I redefine built in Perl functions?
And the answers have served me well. I have a package that overrides Perl's 'open' function enabling me to log file access.
Now I've come to a case that breaks the functionality of the original code.
use strict;
use warnings;
use Data::Dumper;
sub myopen (*;#) {
my $p;
my $retval = CORE::open($p, $_[1]);
{
no strict;
*{"main::$_[0]"} = $p;
}
return $retval;
}
BEGIN {
*CORE::GLOBAL::open = *myopen;
};
my #a = (1, 2, 3);
open(CHECK, ">dump") or print "UNABLE TO OPEN DUMPER FILE: $!\n";
print CHECK "test\n";
print CHECK Data::Dumper->Dump(\#a);
close CHECK
Now I get this message:
Can't locate object method "CHECK" via package "Data::Dumper"
How do I fix it?
Try using a name other than "CHECK".
"CHECK" is a special function which is called during compile time, and you really shouldn't use it.
$ open CHECK , '<', 'foo.txt';
Took 0.00224494934082031 seconds.
Runtime error: Undefined subroutine &Devel::REPL::Plugin::Packages::DefaultScratchpad::CHECK called at (eval 329) line 5.
$ open CHECKS , '<', 'foo.txt';
Took 0.00155806541442871 seconds.
$
More on 'CHECK'
Why that specific error?
perl -MO=Deparse -e 'print CHECK Data::Dumper 1';
print 'Data::Dumper'->CHECK(1);
Also, you're using global file handles, which are problematic.
use this notation:
open my $fh, '<' , $foo ;
print <$fh>;
close $fh;
These are extra beneficial is they self-close when they go out of scope.
Compare:
> perl -MData::Dumper -e'local*_=*STDOUT;print _ Data::Dumper->Dump([2]);'
Can't locate object method "_" via package "Data::Dumper" at -e line 1.
to
> perl -MData::Dumper -e'local*_=*STDOUT;print _ ( Data::Dumper->Dump([2]) );'
$VAR1 = 2;
I used a different name from "STDOUT" because it seems to only gets the indirect object wrong when it's not a built-in handle.
This will work and without producing the error...
print {*CHECK} Data::Dumper->Dump(\#a);
This stops it being confused has an "Indirect Object Syntax"
However I do recommend steering clear of using CHECK and other special named code blocks in Perl and using lexical variables for filehandles is the preferred method. PBP
You sometimes hear it said about Perl that there might be 6 different ways to approach the same problem. Good Perl developers usually have well-reasoned insights for making choices between the various possible methods of implementation.
So an example Perl problem:
A simple script which recursively iterates through a directory structure, looking for files which were modified recently (after a certain date, which would be variable). Save the results to a file.
The question, for Perl developers: What is your best way to accomplish this?
This sounds like a job for File::Find::Rule:
#!/usr/bin/perl
use strict;
use warnings;
use autodie; # Causes built-ins like open to succeed or die.
# You can 'use Fatal qw(open)' if autodie is not installed.
use File::Find::Rule;
use Getopt::Std;
use constant SECONDS_IN_DAY => 24 * 60 * 60;
our %option = (
m => 1, # -m switch: days ago modified, defaults to 1
o => undef, # -o switch: output file, defaults to STDOUT
);
getopts('m:o:', \%option);
# If we haven't been given directories to search, default to the
# current working directory.
if (not #ARGV) {
#ARGV = ( '.' );
}
print STDERR "Finding files changed in the last $option{m} day(s)\n";
# Convert our time in days into a timestamp in seconds from the epoch.
my $last_modified_timestamp = time() - SECONDS_IN_DAY * $option{m};
# Now find all the regular files, which have been modified in the last
# $option{m} days, looking in all the locations specified in
# #ARGV (our remaining command line arguments).
my #files = File::Find::Rule->file()
->mtime(">= $last_modified_timestamp")
->in(#ARGV);
# $out_fh will store the filehandle where we send the file list.
# It defaults to STDOUT.
my $out_fh = \*STDOUT;
if ($option{o}) {
open($out_fh, '>', $option{o});
}
# Print our results.
print {$out_fh} join("\n", #files), "\n";
Where the problem is solved mainly by standard libraries use them.
File::Find in this case works nicely.
There may be many ways to do things in perl, but where a very standard library exists to do something, it should be utilised unless it has problems of it's own.
#!/usr/bin/perl
use strict;
use File::Find();
File::Find::find( {wanted => \&wanted}, ".");
sub wanted {
my (#stat);
my ($time) = time();
my ($days) = 5 * 60 * 60 * 24;
#stat = stat($_);
if (($time - $stat[9]) >= $days) {
print "$_ \n";
}
}
There aren't six ways to do this, there's the old way, and the new way. The old way is with File::Find, and you already have a couple of examples of that. File::Find has a pretty awful callback interface, it was cool 20 years ago, but we've moved on since then.
Here's a real life (lightly amended) program I use to clear out the cruft on one of my production servers. It uses File::Find::Rule, rather than File::Find. File::Find::Rule has a nice declarative interface that reads easily.
Randal Schwartz also wrote File::Finder, as a wrapper over File::Find. It's quite nice but it hasn't really taken off.
#! /usr/bin/perl -w
# delete temp files on agr1
use strict;
use File::Find::Rule;
use File::Path 'rmtree';
for my $file (
File::Find::Rule->new
->mtime( '<' . days_ago(2) )
->name( qr/^CGItemp\d+$/ )
->file()
->in('/tmp'),
File::Find::Rule->new
->mtime( '<' . days_ago(20) )
->name( qr/^listener-\d{4}-\d{2}-\d{2}-\d{4}.log$/ )
->file()
->maxdepth(1)
->in('/usr/oracle/ora81/network/log'),
File::Find::Rule->new
->mtime( '<' . days_ago(10) )
->name( qr/^batch[_-]\d{8}-\d{4}\.run\.txt$/ )
->file()
->maxdepth(1)
->in('/var/log/req'),
File::Find::Rule->new
->mtime( '<' . days_ago(20) )
->or(
File::Find::Rule->name( qr/^remove-\d{8}-\d{6}\.txt$/ ),
File::Find::Rule->name( qr/^insert-tp-\d{8}-\d{4}\.log$/ ),
)
->file()
->maxdepth(1)
->in('/home/agdata/import/logs'),
File::Find::Rule->new
->mtime( '<' . days_ago(90) )
->or(
File::Find::Rule->name( qr/^\d{8}-\d{6}\.txt$/ ),
File::Find::Rule->name( qr/^\d{8}-\d{4}\.report\.txt$/ ),
)
->file()
->maxdepth(1)
->in('/home/agdata/redo/log'),
) {
if (unlink $file) {
print "ok $file\n";
}
else {
print "fail $file: $!\n";
}
}
{
my $now;
sub days_ago {
# days as number of seconds
$now ||= time;
return $now - (86400 * shift);
}
}
File::Find is the right way to solve this problem. There is no use in reimplementing stuff that already exists in other modules, but reimplementing something that is in a standard module should really be discouraged.
Others have mentioned File::Find, which is the way I'd go, but you asked for an iterator, which File::Find isn't (nor is File::Find::Rule). You might want to look at File::Next or File::Find::Object, which do have an iterative interfaces. Mark Jason Dominus goes over building your own in chapter 4.2.2 of Higher Order Perl.
My preferred method is to use the File::Find module as so:
use File::Find;
find (\&checkFile, $directory_to_check_recursively);
sub checkFile()
{
#examine each file in here. Filename is in $_ and you are chdired into it's directory
#directory is also available in $File::Find::dir
}
There's my File::Finder, as already mentioned, but there's also my iterator-as-a-tied-hash solution from Finding Files Incrementally (Linux Magazine).
I wrote File::Find::Closures as a set of closures that you can use with File::Find so you don't have to write your own. There's a couple of mtime functions that should handle
use File::Find;
use File::Find::Closures qw(:all);
my( $wanted, $list_reporter ) = find_by_modified_after( time - 86400 );
#my( $wanted, $list_reporter ) = find_by_modified_before( time - 86400 );
File::Find::find( $wanted, #directories );
my #modified = $list_reporter->();
You don't really need to use the module because I mostly designed it as a way that you could look at the code and steal the parts that you wanted. In this case it's a little trickier because all the subroutines that deal with stat depend on a second subroutine. You'll quickly get the idea from the code though.
Good luck,
Using standard modules is indeed a good idea but out of interest here is my back to basic approach using no external modules. I know code syntax here might not be everyone's cup of tea.
It could be improved to use less memory via providing an iterator access (input list could temporarily be on hold once it reaches a certain size) and conditional check can be expanded via callback ref.
sub mfind {
my %done;
sub find {
my $last_mod = shift;
my $path = shift;
#determine physical link if symlink
$path = readlink($path) || $path;
#return if already processed
return if $done{$path} > 1;
#mark path as processed
$done{$path}++;
#DFS recursion
return grep{$_} #_
? ( find($last_mod, $path), find($last_mod, #_) )
: -d $path
? find($last_mod, glob("$path/*") )
: -f $path && (stat($path))[9] >= $last_mod
? $path : undef;
}
return find(#_);
}
print join "\n", mfind(time - 1 * 86400, "some path");
I write a subroutine that reads a directory with readdir, throws out the "." and ".." directories, recurses if it finds a new directory, and examines the files for what I'm looking for (in your case, you'll want to use utime or stat). By time the recursion is done, every file should have been examined.
I think all the functions you'd need for this script are described briefly here:
http://www.cs.cf.ac.uk/Dave/PERL/node70.html
The semantics of input and output are a fairly trivial exercise which I'll leave to you.
I'm riskying to get downvoted, but IMHO 'ls' (with appropriate params) command does it in a best known performant way. In this case it might be quite good solution to pipe 'ls' from perl code through shell, returning results to an array or hash.
Edit: It could also be 'find' used, as proposed in comments.
I have Perl script and need to determine the full path and filename of the script during execution. I discovered that depending on how you call the script $0 varies and sometimes contains the fullpath+filename and sometimes just filename. Because the working directory can vary as well I can't think of a way to reliably get the fullpath+filename of the script.
Anyone got a solution?
There are a few ways:
$0 is the currently executing script as provided by POSIX, relative to the current working directory if the script is at or below the CWD
Additionally, cwd(), getcwd() and abs_path() are provided by the Cwd module and tell you where the script is being run from
The module FindBin provides the $Bin & $RealBin variables that usually are the path to the executing script; this module also provides $Script & $RealScript that are the name of the script
__FILE__ is the actual file that the Perl interpreter deals with during compilation, including its full path.
I've seen the first three ($0, the Cwd module and the FindBin module) fail under mod_perl spectacularly, producing worthless output such as '.' or an empty string. In such environments, I use __FILE__ and get the path from that using the File::Basename module:
use File::Basename;
my $dirname = dirname(__FILE__);
$0 is typically the name of your program, so how about this?
use Cwd 'abs_path';
print abs_path($0);
Seems to me that this should work as abs_path knows if you are using a relative or absolute path.
Update For anyone reading this years later, you should read Drew's answer. It's much better than mine.
use File::Spec;
File::Spec->rel2abs( __FILE__ );
http://perldoc.perl.org/File/Spec/Unix.html
I think the module you're looking for is FindBin:
#!/usr/bin/perl
use FindBin;
$0 = "stealth";
print "The actual path to this is: $FindBin::Bin/$FindBin::Script\n";
You could use FindBin, Cwd, File::Basename, or a combination of them. They're all in the base distribution of Perl IIRC.
I used Cwd in the past:
Cwd:
use Cwd qw(abs_path);
my $path = abs_path($0);
print "$path\n";
Getting the absolute path to $0 or __FILE__ is what you want. The only trouble is if someone did a chdir() and the $0 was relative -- then you need to get the absolute path in a BEGIN{} to prevent any surprises.
FindBin tries to go one better and grovel around in the $PATH for something matching the basename($0), but there are times when that does far-too-surprising things (specifically: when the file is "right in front of you" in the cwd.)
File::Fu has File::Fu->program_name and File::Fu->program_dir for this.
Some short background:
Unfortunately the Unix API doesn't provide a running program with the full path to the executable. In fact, the program executing yours can provide whatever it wants in the field that normally tells your program what it is. There are, as all the answers point out, various heuristics for finding likely candidates. But nothing short of searching the entire filesystem will always work, and even that will fail if the executable is moved or removed.
But you don't want the Perl executable, which is what's actually running, but the script it is executing. And Perl needs to know where the script is to find it. It stores this in __FILE__, while $0 is from the Unix API. This can still be a relative path, so take Mark's suggestion and canonize it with File::Spec->rel2abs( __FILE__ );
Have you tried:
$ENV{'SCRIPT_NAME'}
or
use FindBin '$Bin';
print "The script is located in $Bin.\n";
It really depends on how it's being called and if it's CGI or being run from a normal shell, etc.
In order to get the path to the directory containing my script I used a combination of answers given already.
#!/usr/bin/perl
use strict;
use warnings;
use File::Spec;
use File::Basename;
my $dir = dirname(File::Spec->rel2abs(__FILE__));
perlfaq8 answers a very similar question with using the rel2abs() function on $0. That function can be found in File::Spec.
There's no need to use external modules, with just one line you can have the file name and relative path. If you are using modules and need to apply a path relative to the script directory, the relative path is enough.
$0 =~ m/(.+)[\/\\](.+)$/;
print "full path: $1, file name: $2\n";
#!/usr/bin/perl -w
use strict;
my $path = $0;
$path =~ s/\.\///g;
if ($path =~ /\//){
if ($path =~ /^\//){
$path =~ /^((\/[^\/]+){1,}\/)[^\/]+$/;
$path = $1;
}
else {
$path =~ /^(([^\/]+\/){1,})[^\/]+$/;
my $path_b = $1;
my $path_a = `pwd`;
chop($path_a);
$path = $path_a."/".$path_b;
}
}
else{
$path = `pwd`;
chop($path);
$path.="/";
}
$path =~ s/\/\//\//g;
print "\n$path\n";
:DD
Are you looking for this?:
my $thisfile = $1 if $0 =~
/\\([^\\]*)$|\/([^\/]*)$/;
print "You are running $thisfile
now.\n";
The output will look like this:
You are running MyFileName.pl now.
It works on both Windows and Unix.
The problem with just using dirname(__FILE__) is that it doesn't follow symlinks. I had to use this for my script to follow the symlink to the actual file location.
use File::Basename;
my $script_dir = undef;
if(-l __FILE__) {
$script_dir = dirname(readlink(__FILE__));
}
else {
$script_dir = dirname(__FILE__);
}
use strict ; use warnings ; use Cwd 'abs_path';
sub ResolveMyProductBaseDir {
# Start - Resolve the ProductBaseDir
#resolve the run dir where this scripts is placed
my $ScriptAbsolutPath = abs_path($0) ;
#debug print "\$ScriptAbsolutPath is $ScriptAbsolutPath \n" ;
$ScriptAbsolutPath =~ m/^(.*)(\\|\/)(.*)\.([a-z]*)/;
$RunDir = $1 ;
#debug print "\$1 is $1 \n" ;
#change the \'s to /'s if we are on Windows
$RunDir =~s/\\/\//gi ;
my #DirParts = split ('/' , $RunDir) ;
for (my $count=0; $count < 4; $count++) { pop #DirParts ; }
my $ProductBaseDir = join ( '/' , #DirParts ) ;
# Stop - Resolve the ProductBaseDir
#debug print "ResolveMyProductBaseDir $ProductBaseDir is $ProductBaseDir \n" ;
return $ProductBaseDir ;
} #eof sub
The problem with __FILE__ is that it will print the core module ".pm" path not necessarily the ".cgi" or ".pl" script path that is running. I guess it depends on what your goal is.
It seems to me that Cwd just needs to be updated for mod_perl. Here is my suggestion:
my $path;
use File::Basename;
my $file = basename($ENV{SCRIPT_NAME});
if (exists $ENV{MOD_PERL} && ($ENV{MOD_PERL_API_VERSION} < 2)) {
if ($^O =~/Win/) {
$path = `echo %cd%`;
chop $path;
$path =~ s!\\!/!g;
$path .= $ENV{SCRIPT_NAME};
}
else {
$path = `pwd`;
$path .= "/$file";
}
# add support for other operating systems
}
else {
require Cwd;
$path = Cwd::getcwd()."/$file";
}
print $path;
Please add any suggestions.
Without any external modules, valid for shell, works well even with '../':
my $self = `pwd`;
chomp $self;
$self .='/'.$1 if $0 =~/([^\/]*)$/; #keep the filename only
print "self=$self\n";
test:
$ /my/temp/Host$ perl ./host-mod.pl
self=/my/temp/Host/host-mod.pl
$ /my/temp/Host$ ./host-mod.pl
self=/my/temp/Host/host-mod.pl
$ /my/temp/Host$ ../Host/./host-mod.pl
self=/my/temp/Host/host-mod.pl
All the library-free solutions don't actually work for more than a few ways to write a path (think ../ or /bla/x/../bin/./x/../ etc. My solution looks like below. I have one quirk: I don't have the faintest idea why I have to run the replacements twice. If I don't, I get a spurious "./" or "../". Apart from that, it seems quite robust to me.
my $callpath = $0;
my $pwd = `pwd`; chomp($pwd);
# if called relative -> add pwd in front
if ($callpath !~ /^\//) { $callpath = $pwd."/".$callpath; }
# do the cleanup
$callpath =~ s!^\./!!; # starts with ./ -> drop
$callpath =~ s!/\./!/!g; # /./ -> /
$callpath =~ s!/\./!/!g; # /./ -> / (twice)
$callpath =~ s!/[^/]+/\.\./!/!g; # /xxx/../ -> /
$callpath =~ s!/[^/]+/\.\./!/!g; # /xxx/../ -> / (twice)
my $calldir = $callpath;
$calldir =~ s/(.*)\/([^\/]+)/$1/;
None of the "top" answers were right for me. The problem with using FindBin '$Bin' or Cwd is that they return absolute path with all symbolic links resolved. In my case I needed the exact path with symbolic links present - the same as returns Unix command "pwd" and not "pwd -P". The following function provides the solution:
sub get_script_full_path {
use File::Basename;
use File::Spec;
use Cwd qw(chdir cwd);
my $curr_dir = cwd();
chdir(dirname($0));
my $dir = $ENV{PWD};
chdir( $curr_dir);
return File::Spec->catfile($dir, basename($0));
}
On Windows using dirname and abs_path together worked best for me.
use File::Basename;
use Cwd qw(abs_path);
# absolute path of the directory containing the executing script
my $abs_dirname = dirname(abs_path($0));
print "\ndirname(abs_path(\$0)) -> $abs_dirname\n";
here's why:
# this gives the answer I want in relative path form, not absolute
my $rel_dirname = dirname(__FILE__);
print "dirname(__FILE__) -> $rel_dirname\n";
# this gives the slightly wrong answer, but in the form I want
my $full_filepath = abs_path($0);
print "abs_path(\$0) -> $full_filepath\n";
use File::Basename;
use Cwd 'abs_path';
print dirname(abs_path(__FILE__)) ;
Drew's answer gave me:
'.'
$ cat >testdirname
use File::Basename;
print dirname(__FILE__);
$ perl testdirname
.$ perl -v
This is perl 5, version 28, subversion 1 (v5.28.1) built for x86_64-linux-gnu-thread-multi][1]
What's wrong with $^X ?
#!/usr/bin/env perl<br>
print "This is executed by $^X\n";
Would give you the full path to the Perl binary being used.
Evert
On *nix, you likely have the "whereis" command, which searches your $PATH looking for a binary with a given name. If $0 doesn't contain the full path name, running whereis $scriptname and saving the result into a variable should tell you where the script is located.