I searched from internet, but I only found php solutions to this problem. Please help if you know how to do this in perl.
I am trying to generate a webpage showing the content of a directory on my server's local disk. For example, a page containing the following will do the work
<file name="file1" href="file1" />
<dir name="dir1" href="dir1/" />
<dir name="dir2" href="dir2/" />
Thank you for your help.
Modifications have to be made to secure the script and also in jailing it. However, the idea can be implemented like:
#!/usr/bin/perl -T
use strict;
use warnings;
use CGI;
use File::Basename;
use File::Spec;
use Path::Trim;
my $cgi = CGI->new();
if ( my $file = $cgi->param('file') ) {
open my $fh, '<', $file or die $!;
print $cgi->header(
'-type' => 'application/octet-stream',
'-attachment' => basename($file),
'-Content_Length' => -s $file,
);
binmode $fh;
print while <$fh>;
}
else {
my $path = $cgi->param('path');
print $cgi->header(), $cgi->start_html();
# remove redundant current directory and parent directory entries
my $pt = Path::Trim->new();
$pt->set_directory_separator('/');
$path = $pt->trim_path($path);
# remove all ../ and ./ that have accumulated at the beginning of the path and
# make the path absolute by prepending a /
$path =~ s{^ (\.\.? /)+ }{}x;
$path = "/$path" unless $path =~ m{^ / }x;
print $cgi->h1($path);
opendir my $dh, $path or die $!;
my #entries = grep { $_ !~ /^ \. $/x } readdir $dh;
closedir $dh;
print $cgi->start_ul();
for my $entry ( sort { $a cmp $b } #entries ) {
if ( -d File::Spec->catfile( $path, $entry ) ) {
my $abs_entry = File::Spec->catfile( $path, $entry );
my $anchor = $cgi->a( { 'href' => "?path=$abs_entry" }, $entry );
print $cgi->li($anchor);
}
else {
my $abs_entry = File::Spec->catfile( $path, $entry );
my $anchor = $cgi->a( { 'href' => "?file=$abs_entry" }, $entry );
print $cgi->li($anchor);
}
}
print $cgi->end_ul(), $cgi->end_html();
}
This should get you started:
#!/usr/bin/perl -Tw
use 5.008_001;
use strict;
use warnings;
print "Content-Type: text/html; charset=utf-8\r\n\r\n";
print <<EOF;
<html>
<head>
<title>Directory Listing</title>
</head>
<body>
<pre>
EOF
opendir(my $dir, ".");
foreach(sort readdir $dir) {
my $isDir = 0;
$isDir = 1 if -d $_;
$_ =~ s/&/&/g;
$_ =~ s/"/"/g;
$_ =~ s/</</g;
$_ =~ s/>/>/g;
my $type = "[ ]";
$type = "[D]" if $isDir;
print "$type$_\n";
}
print <<EOF;
</pre>
</body>
</html>
EOF
Related
I want to search string in directory using Perl File::Find, but it's not working. It gave me an error:
C:/Perl64/bin/perl.exe D:/DUAN/MailScanner/GetMailForwarder.pl
Error openning file: D:\DUAN\MailScanner\valiases Permission denied
Process finished with exit code 13
Here is my code:
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
use Data::Dump qw(dump);
my #dirs = 'D:\DUAN\MailScanner\valiases';
## main processing done here
my #found_files = ();
my $pattern = qr/World/;
find( \&wanted, #dirs );
sub wanted
{
next if ($File::Find::name =~ m/^\./);
open my $file, '<', $File::Find::name or die "Error openning file: $File::Find::name $!\n";
while( defined(my $line = <$file>) )
{
if ($line =~ /$pattern/)
{
push #found_files, $_;
last;
}
}
close ($file);
}
foreach my $file(#found_files)
{
print $file, "\n";
}
Very happy to see use strict; - good job!
The following minor code mod should help you get to the bottom of whatever problem you have.
use strict;
use warnings;
use File::Find;
use Data::Dump qw(dump);
my #dirs = ('D:\DUAN\MailScanner\valiases', 'D:\DUAN\additionalPath');
foreach my $dir (#dirs)
{
print "WARNING: $dir is not a directory/folder.\n" unless ( -d $dir );
}
## main processing done here
my #found_files = ();
my $pattern = qr/World/;
find( \&wanted, #dirs );
sub wanted
{
next if ($File::Find::name =~ m/^\./);
if (-r $File::Find::name)
{
open my $file, '<', $File::Find::name or die "Error reading file: $File::Find::name $!\n";
while ( my $line = <$file> )
{
if ($line =~ m/$pattern/)
{
push #found_files, $_;
last;
}
}
close ($file);
}
else
{
print "WARNING: $File::Find::name is not readable. Skipping...\n";
}
}
foreach my $file (#found_files)
{
print "$file\n";
}
Simple test case (for the demonstration of the problem):
mkdir -p ./lib1/Class ./lib2/Class
touch ./lib1/Class/Name.pm ./lib2/Class/NAME.pm
So, have:
./lib1/Class/Name.pm
./lib2/Class/NAME.pm
Need search for the right file in the case-insensitive filesystem (OS X's HFS+).
The following works on case-sensitive filesystem,
#!/usr/bin/env perl
use 5.014;
use strict;
use warnings;
my #DIRS = qw(./lib1 ./lib2);
for my $class ( qw(Class::Name Class::NAME) ) {
my $file = findClassFile($class);
say $file;
}
sub findClassFile {
my($file) = #_;
$file =~ s|::|/|g;
$file .= ".pm";
for my $dir (#DIRS) {
return "$dir/$file" if( -e "$dir/$file" );
}
return undef;
}
and prints
./lib1/Class/Name.pm
./lib2/Class/NAME.pm
on the OS X, it prints incorrectly:
./lib1/Class/Name.pm
./lib1/Class/NAME.pm
How to find on the OSX's insensitive filesystem the correct filename?
Ps: Now only comes to my mind write and recursive routine with opendir/readdir/chdir and checking the filenames what are comes from readdir. Not to shabby... Exists some more easy way?
My current solution is:
#!/usr/bin/env perl
use 5.014;
use strict;
use warnings;
my #DIRS = qw(./lib1 ./lib2 /Users/me/tmp/lib3);
for my $class ( qw(Class::Name Class::NAME CLASS::name Class::Namex) ) {
my $file = findClassFile($class);
say $file // "Not found $class";
}
sub findClassFile {
my($classname) = #_;
my $file = ($classname =~ s|::|/|gr) . ".pm";
for my $dir (#DIRS) {
return "$dir/$file" if( FileExists("$dir/$file") );
}
return undef;
}
sub FileExists {
my($path) = #_;
my $curr = $path =~ m|^/| ? "/" : ".";
for my $part (split '/', $path) {
next unless $part;
opendir(my $dfd, $curr) || return undef;
my #files = grep {/^$part$/} readdir($dfd);
closedir($dfd);
return undef unless( #files );
$curr .= "/$part";
}
return $curr;
}
what prints:
./lib1/Class/Name.pm
./lib2/Class/NAME.pm
/Users/me/tmp/lib3/CLASS/name.pm
Not found Class::Namex
so - it's working, only don't like it.. ;)
When initially checking if ARGV[0] is a file or directory, it worked fine with accurate results. Then further down into sub files I try it again and it doesnt return anything. This may seem like a small silly question but Im a student and help on programming on the weekends is scarce. Sometimes a new set of eyes can help.Thanks in advance.
#!/usr/bin/perl -w
my %hash;
my $args = #ARGV;
my $dh = $ARGV[0];
if ( -f $dh ) {
words($dh);
} elsif ( -d $dh ) {
files($dh);
}
sub words {
open( my $file, '<', $_[0] ) or die 'cant open file';
while ( my $line = <$file> ) {
chomp $line;
#words = split( /\s+/, $line );
foreach $word (#words) {
$word =~ tr/A-Z/a-z/;
$hash{$word}++;
}
}
foreach $key ( keys %hash ) {
print $key. " " . $hash{$key} . "\n";
}
}
sub files {
opendir( DH, $_[0] );
my #paths = grep !/^\./, readdir(DH);
closedir(DH);
foreach (#paths) {
if ( -f $_ ) {
print $_. "\n";
}
}
}
You're missing path to your file,
if (-f "$_[0]/$_") ..
or to make it less obscure,
sub files{
my ($path) = #_;
opendir(my $DH, $path);
my #paths = grep !/^\./, readdir($DH);
closedir($DH);
foreach (#paths) {
if (-f "$path/$_") {
print "$_\n";
}
}
}
As has already been stated, the return values of readdir contain just the basename. Therefore, to do file tests, you must either chdir or include the path info explicitly.
if (-f "$_[0]/$_") {
One alternative solution is to use Path::Class or some similar module for doing Cross-platform path specification manipulation.
The following is your script rewritten using this module:
use strict;
use warnings;
use Path::Class;
my $path = shift // die "Usage: $0 <Dir or File>\n";
words($path) if -f $path;
files($path) if -d $path;
sub words {
my $file = file(shift);
my %count;
$count{ lc($_) }++ for split ' ', $file->slurp;
for my $key ( keys %count ) {
printf "%s %s\n", $key, $count{$key};
}
}
sub files {
my $dir = dir(shift);
for ( $dir->children ) {
next if $_->is_dir;
print "$_\n", $_->basename;
}
}
I'm trying to clean up a directory that contains a lot of sub directories that actually belong in some of the sub directories, not the main directory.
For example, there is
Main directory
sub1
sub2
sub3
HHH
And HHH belongs in sub3. HHH has multiple text files inside of it (as well as some ..txt and ...txt files that I would like to ignore), and each of these text files has a string
some_pattern [sub3].
So, I attempted to write a script that looks into the file and then moves it into its corresponding directory
use File::Find;
use strict;
use warnings;
use File::Copy;
my $DATA = "D:/DATA/DATA_x/*";
my #dirs = grep { -d } glob $DATA;
foreach (#dirs) {
if ($_ =~ m/HHH/) {
print "$_\n";
my $file = "$_/*";
my #files = grep { -f } glob $file;
foreach (#files) {
print "file $_\n";
}
foreach (#files) {
print "\t$_\n";
my #folders = split('/', $_);
if ($folders[4] eq '..txt' or $folders[4] eq '...txt') {
print "$folders[4] ..txt\n";
}
foreach (#folders) {
print "$_\n";
}
open(FH, '<', $_);
my $value;
while (my $line = <FH>) {
if ($line =~ m/some_pattern/) {
($value) = $line =~ /\[(.+?)\]/;
($value) =~ s/\s*$//;
print "ident'$value'\n";
my $new_dir = "$folders[0]/$folders[1]/$folders[2]/$value/$folders[3]/$folders[4]";
print "making $folders[0]/$folders[1]/$folders[2]/$value/$folders[3]\n";
print "file is $folders[4]\n";
my $new_over_dir = "$folders[0]/$folders[1]/$value/$folders[2]/$folders[3]";
mkdir $new_over_dir or die "Can't make it $!";
print "going to swap\n '$_'\n for\n '$new_dir'\n";
move($_, $new_dir) or die "Can't $!";
}
}
}
}
}
It's saying
Can't make it No such file or directory at foo.pl line 57, <FH> line 82.
Why is it saying that it won't make a file that doesn't exist?
A while later: here is my final script:
use File::Find;
use strict;
use warnings;
use File::Copy;
my $DATA = "D:/DATA/DATA_x/*";
my #dirs = grep { -d } glob $DATA;
foreach (#dirs) {
if ($_ =~ m/HHH/) {
my $value;
my #folders;
print "$_\n";
my $file = "$_/*";
my #files = grep { -f } glob $file;
foreach (#files) {
print "file $_\n";
}
foreach (#files) {
print "\t$_\n";
#folders = split('/', $_);
if ($folders[4] eq '..txt' or $folders[4] eq '...txt') {
print "$folders[4] ..txt\n";
}
foreach (#folders) {
print "$_\n";
}
open(FH, '<', $_);
while (my $line = <FH>) {
if ($line =~ m/some_pattern/) {
($value) = $line =~ /\[(.+?)\]/;
($value) =~ s/\s*$//;
print "ident'$value'\n";
}
}
}
if($value){
print "value $value\n";
my $dir1 = "/$folders[1]/$folders[2]/$folders[3]/$folders[4]/$folders[5]";
my $dir2 = "/$folders[1]/$folders[2]/$folders[3]/$folders[4]/$value";
system("cp -r $dir1 $dir2");
}
}
}
}
This works. It looks like part of my problem from before was that I was trying to run this on a directory in my D: drive--when I moved it to the C: drive, it worked fine without any permissions errors or anything. I did try to implement something with Path::Tiny, but this script was so close to being functional (and it was functional in a Unix environment), that I decided to just complete it.
You really should read the Path::Tiny doccu. It probably contains everything you need.
Some starting points, without error handling and so on...
use strict;
use warnings;
use Path::Tiny;
my $start=path('D:/DATA/DATA_x');
my $iter = path($start)->iterator({recurse => 1});
while ( $curr = $iter->() ) {
#select here the needed files - add more conditions if need
next if $curr->is_dir; #skip directories
next if $curr =~ m/HHH.*\.{2,3}txt$/; #skip ...?txt
#say "$curr";
my $content = $curr->slurp;
if( $content =~ m/some_pattern/ ) {
#do something wih the file
say "doing something with $curr";
my $newfilename = path("insert what you need here"); #create the needed new path for the file ..
path($newfilename->dirname)->mkpath; #make directories
$curr->move($newfilename); #move the file
}
}
Are you sure of the directory path you are trying to create. The mkdir call might be failing if some of the intermediate directories doesn't exist. If your code is robust to ensure that
the variable $new_over_dir contains the directory path you have to create, you can use method make_path from perl module File::Path to create the new directory, instead of 'mkdir'.
From the documentation of make_path:
The make_path function creates the given directories if they don't
exists before, much like the Unix command mkdir -p.
I have two nested foreach loops. If I use this code:
foreach (#directories) {
my $actual_directory = $_;
print "\nactual directory: ".$actual_directory."\n";
foreach (#files) {
my $file_name = $_;
my $actual_file = $actual_directory.$file_name;
print $actual_file."\n";
open(DATA, $actual_file) or die "Nelze otevřít zdrojový soubor: $!\n";
my $line_number = 0;
# while (<DATA>){
# my #znaky = split(' ',$_);
# my $poradi = $znaky[0]; #poradi nukleotidu
# my $hodnota = $znaky[1]; #hodnota
# my #temp = $files_to_sum_of_lines{$actual_file};
# $temp[$line_number] += $hodnota;
# $files_to_sum_of_lines{$actual_file} = #temp;
# $line_number+=1;
# }
# close(DATA);
}
}
I got this output:
actual directory: /home/n/Plocha/counting_files/1/
/home/n/Plocha/counting_files/1/a.txt
/home/n/Plocha/counting_files/1/b.txt
actual directory: /home/n/Plocha/counting_files/2/
/home/n/Plocha/counting_files/2/a.txt
/home/n/Plocha/counting_files/2/b.txt
However, if I uncomment "while (<DATA>){ }", I loose a.txt and b.txt, so the output looks like this:
actual directory: /home/n/Plocha/counting_files/1/
/home/n/Plocha/counting_files/1/a.txt
/home/n/Plocha/counting_files/1/b.txt
actual directory: /home/n/Plocha/counting_files/2/
/home/n/Plocha/counting_files/2/
/home/n/Plocha/counting_files/2/
How can this while (<DATA>) prevent my foreach from being executed?
Any help will be appreciated. Thanks a lot.
In addition to not using DATA, try using lexical loop variables, and lexical filehandles. Also, Perl's built-in $. keeps track of line numbers for you.
for my $actual_directory (#directories) {
print "\nactual directory: ".$actual_directory."\n";
foreach my $file_name (#files) {
my $actual_file = $actual_directory.$file_name;
print $actual_file."\n";
open my $INPUT, '<', $actual_file
or die "Nelze otevřít zdrojový soubor: $!\n";
while (my $line = <$INPUT>) {
my #znaky = split(' ', $line);
my $poradi = $znaky[0]; #poradi nukleotidu
my $hodnota = $znaky[1]; #hodnota
#temp = $files_to_sum_of_lines{$actual_file};
$temp[ $. ] += $hodnota;
$files_to_sum_of_lines{$actual_file} = #temp;
}
close $INPUT;
}
}
On the other hand, I can't quite tell if there is a logic error in there. Something like the following might be useful:
#!/usr/bin/perl
use warnings; use strict;
use Carp;
use File::Find;
use File::Spec::Functions qw( catfile canonpath );
my %counts;
find(\&count_lines_in_files, #ARGV);
for my $dir (sort keys %counts) {
print "$dir\n";
my $dircounts = $counts{ $dir };
for my $file (sort keys %{ $dircounts }) {
printf "\t%s: %d\n", $file, $dircounts->{ $file };
}
}
sub count_lines_in_files {
my $file = canonpath $_;
my $dir = canonpath $File::Find::dir;
my $path = canonpath $File::Find::name;
return unless -f $path;
$counts{ $dir }{ $file } = count_lines_in_file($path);
}
sub count_lines_in_file {
my ($path) = #_;
my $ret = open my $fh, '<', $path;
unless ($ret) {
carp "Cannot open '$path': $!";
return;
}
1 while <$fh>;
my $n_lines = $.;
close $fh
or croak "Cannot close '$path': $!";
return $n_lines;
}
Perl uses __DATA__ to make a pseudo-data file at the end of the package. You can access that using the filehandle DATA, e.g. <DATA>. Is it possible that your filehandle is conflicting? Try changing the filehandle to something else and see if it works better.