I have a script which poplulates filenames and last modified time of the respective file under a particular directory. I have used DosGlob module to specify the regex.
Sample directory structure is:
//share16/ABC/X/Output/1/
//share16/ABC/X/Output/2/
//share16/ABC/Y/Output/1/
//share16/ABC/Y/Output/2/
Below is the code which does the above and there is further code after this which is out of present context.
use File::DosGlob 'glob';
my #dir_regex = glob "//share16/ABC/*/Output/";
for my $dir (#dir_regex) {
find( { wanted => \&process_file, no_chdir => 1 }, $dir ) or die $!;
}
sub process_file {
my $dummy = $_;
if ( -f $dummy ) {
my $filename = "//share16/TOOLS/report.txt";
open( my $fh, '>>', $filename )
or die "Could not open file '$filename' $!";
my $last_mod_time = ctime( stat($dummy)->mtime );
print $fh "$last_mod_time $dummy\n";
}
close $fh;
}
The script successfully lists down the files under all folders (folder 1, folder 2) under the first directory X but fails immediately when it starts reading the folder Y.
Error: No such file or directory at \share16\traverse4.pl line 5.
I am clueless as to why it is failing as I have tried hardcoding the foldername in dir_regex but it still fails after listing the files under the first directory.
Because you set no_chdir so find doesn't chdir. Thus your various calls - with a relative path - fails. The simple solution would be using $File::Find::name instead of $_
I'd also note - you can just specify a directory list to File::Find - you don't need to do each separately.
Related
I am trying to compress a folder containing files and subfolders (with files) into a single zip. I'm limited to the core perl modules so I'm trying to work with IO::Compress::Zip. I want to remove the working directory file path but seem to end up with a blank first folder before my zipped folder, like there is a trailing "/" I haven't been able to get rid of.
use Cwd;
use warnings;
use strict;
use File::Find;
use IO::Compress::Zip qw(:all);
my $cwd = getcwd();
$cwd =~ s/[\\]/\//g;
print $cwd, "\n";
my $zipdir = $cwd . "\\source_folder";
my $zip = "source_folder.zip";
my #files = ();
sub process_file {
next if (($_ eq '.') || ($_ eq '..'));
if (-d && $_ eq 'fp'){
$File::Find::prune = 1;
return;
}
push #files, $File::Find::name if -f;
}
find(\&process_file, $cwd . "\\source_folder");
zip \#files => "$zip", FilterName => sub{ s|\Q$cwd|| } or die "zip failed: $ZipError\n";
I have also attempted using the option "CanonicalName => 1, " which appears to leave the filepath except the drive letter (C:).
Substitution with
s[^$dir/][]
did nothing and
s<.*[/\\]><>
left me with no folder structure at all.
What am I missing?
UPDATE
The Red level is unexpected and is what is not required, win explorer is not able to see beyond this level.
There are two issues with your script.
First, you are mixing Windows and Linux/Unix paths in the script. Let me illustrate
I've created a subdirectory called source_folder to match your script
$ dir source_folder
Volume in drive C has no label.
Volume Serial Number is 7CF0-B66E
Directory of C:\Scratch\source_folder
26/11/2018 19:48 <DIR> .
26/11/2018 19:48 <DIR> ..
26/11/2018 17:27 840 try.pl
01/06/2018 13:02 6,653 url
2 File(s) 7,493 bytes
When I run your script unmodified I get an apparently empty zip file when I view it in Windows explorer. But, if I use a command-line unzip, I see that source_folder.zip isn't empty, but it has non-standard filenames that are part Windows and part Linux/Unix.
$ unzip -l source_folder.zip
Archive: source_folder.zip
Length Date Time Name
--------- ---------- ----- ----
840 2018-11-26 17:27 \source_folder/try.pl
6651 2018-06-01 13:02 \source_folder/url
--------- -------
7491 2 files
The mix-and-match of windows & Unix paths is created in this line of your script
find(\&process_file, $cwd . "\\source_folder");
You are concatenating a Unix-style path in $cwd with a windows part "\source_folder".
Change the line to use a forward slash, rather than a backslash to get a consistent Unix-style path.
find(\&process_file, $cwd . "/source_folder");
The second problem is this line
zip \#files => "$zip",
FilterName => sub{ s|\Q$cwd|| },
BinmodeIn =>1
or die "zip failed: $ZipError\n";
The substitute, s|\Q$cwd||, needs an extra "/", like this s|\Q$cwd/|| to make sure that the path added to the zip archive is a relative path. So the line becomes
zip \#files => "$zip", FilterName => sub{ s|\Q$cwd/|| } or die "zip failed: $ZipError\n";
Once those two changes are made I can view the zip file in Explorer and get unix-style relative paths in when I use the command-line unzip
$ unzip -l source_folder.zip
Archive: source_folder.zip
Length Date Time Name
--------- ---------- ----- ----
840 2018-11-26 17:27 source_folder/try.pl
6651 2018-06-01 13:02 source_folder/url
--------- -------
7491 2 files
This works for me:
use Cwd;
use warnings;
use strict;
use File::Find;
use IO::Compress::Zip qw(:all);
use Data::Dumper;
my $cwd = getcwd();
$cwd =~ s/[\\]/\//g;
print $cwd, "\n";
my $zipdir = $cwd . "/source_folder";
my $zip = "source_folder.zip";
my #files = ();
sub process_file {
next if (($_ eq '.') || ($_ eq '..'));
if (-d && $_ eq 'fp') {
$File::Find::prune = 1;
return;
}
push #files, $File::Find::name if -f;
}
find(\&process_file, $cwd . "/source_folder");
print Dumper \#files;
zip \#files => "$zip", FilterName => sub{ s|\Q$cwd/|| } or die "zip failed: $ZipError\n";
I changed the path seperator to '/' in your call to find() and also stripped it in the FilterName sub.
console:
C:\Users\chris\Desktop\devel\experimente>mkdir source_folder
C:\Users\chris\Desktop\devel\experimente>echo 1 > source_folder/test1.txt
C:\Users\chris\Desktop\devel\experimente>echo 1 > source_folder/test2.txt
C:\Users\chris\Desktop\devel\experimente>perl perlzip.pl
C:/Users/chris/Desktop/devel/experimente
Exiting subroutine via next at perlzip.pl line 19.
$VAR1 = [
'C:/Users/chris/Desktop/devel/experimente/source_folder/test1.txt',
'C:/Users/chris/Desktop/devel/experimente/source_folder/test2.txt'
];
C:\Users\chris\Desktop\devel\experimente>tar -tf source_folder.zip
source_folder/test1.txt
source_folder/test2.txt
I am actually Monitoring a directory for creation of new files(.log files) these files are generated by some tool and tool writes log entries after sometime of the creation of the same file, During this time file will be empty.
and how can i wait until something is written to the log and reason being based on the log entries i will be invoking different script!,
use strict;
use warnings;
use File::Monitor;
use File::Basename;
my $script1 = "~/Desktop/parser1.pl";
my $scrip2t = "~/Desktop/parser2.pl";
my $dir = "~/Desktop/tool/logs";
sub textfile_notifier {
my ($watch_name, $event, $change) = #_;
my #new_file_paths = $change->files_created; #The change object has a property called files_created,
#which contains the names of any new files
for my $path (#new_file_paths) {
my ($base, $fname, $ext) = fileparse($path, '.log'); # $ext is "" if the '.log' extension is
# not found, otherwise it's '.log'.
if ($ext eq '.log') {
print "$path was created\n";
if(-z $path){
# i need to wait until something is written to log
}else{
my #arrr = `head -30 $path`;
foreach(#arr){
if(/Tool1/){
system("/usr/bin/perl $script1 $path \&");
}elsif(/Tool1/){
system("/usr/bin/perl $script2 $path \&");
}
}
}
}
my $monitor = File::Monitor->new();
$monitor->watch( {
name => $dir,
recurse => 1,
callback => {files_created => \&textfile_notifier}, #event => handler
} );
$monitor->scan;
while(1){
$monitor->scan;
}
Basically i am grepping some of the important information from the logs.
For such formulation of your question, something like this might help you:
use File::Tail;
# for log file $logname
my #logdata;
my $file = File::Tail->new(name => $logname, maxinterval => 1);
while (defined(my $newline = $file->read)) {
push #logdata, $newline;
# the decision to launch the script according to data in #logdata
}
Read more here
You are monitoring just the log file creation. Maybe you could use a sleep function inside the call back sub to wait for the log file been wrote. You could monitor file changes too, because some log files could be extended.
I need to write a perl program where I parse through an error log and output the error messages to a new file. I am having issues with setting up the regex to do this. In the error log, an error code starts with the word "ERROR" and the end of each error message ends with a ". " (period and then a space). I want to find all the errors, count them, and also output the entire error message of each error message to a new file.
I tried this but am having issues:
open(FH,"<$filetoparse");
$outputfile='./errorlog.txt';
open(OUTPUT,">$outputfile");
$errorstart='ERROR';
$errorend=". ";
while(<FH>)
{
if (FH=~ /^\s*$errorstart/../$errorend/)
{
print OUTPUT "success";
}
else
{
print OUTPUT "failed";
}
}
}
the $errorstart and $errorend are something I saw online and am not sure if that is the correct way to code it.
Also I know the printing "Success" or "Failure" is not what I said I am looking for, I added that in to help with confirmed that the code works, I haven't tried coding for counting the error messages yet.
before this snippet of code I have a print statement asking the user for the location address of the .txt file they want to parse. I confirmed that particular section of code words properly. Thanks for any help! Let me know if more info is needed!
Here is an example of data that I will be using:
Sample Data
-----BEGIN LOAD-----
SUCCESS: file loaded properly .
SUCCESS: file loaded properly .
SUCCESS: file loaded properly .
SUCCESS: file loaded properly .
SUCCESS: file loaded properly .
SUCCESS: file loaded properly .
ERROR: the file was unable to load for an unknown reason .
SUCCESS: file loaded properly .
SUCCESS: file loaded properly .
ERROR: the file was unable to load this is just an example of a log file that will span
multiple lines .
SUCCESS: file loaded properly .
------END LOAD-------
While the log may not necessarily NEED to span multiple lines, there will be some data throughout the log that will similar to how it is above. Every message logged starts with either SUCCESS or ERROR and the message is done when a " . " (whitespace-period-whitespace) is encountered. The log I want to parse through is 50,000 entries long so needless to say I would like to code so it will also identify multi-line error msgs as well as output the entire multi-line message to the output file.
update
I have written the code but for some reason it won't work. I think it has to do with the delimiter but I can't figure out what it is. The file I am using has messages that are separated by "whitespace period newline". Can you see what I'm doing wrong??
{
local $/ = " .\n";
if ($outputtype == 1)
{
$outputfile="errorlog.txt";
open(OUTPUT,">>$outputfile");
$errorcount=0;
$errortarget="ERROR";
print OUTPUT "-----------Error Log-----------\n";
{
while(<FH>)
{
if ($_ =~ m/^$errortarget/)
{
print OUTPUT "$_\n";
print OUTPUT "next code is: \n";
$errorcount++;
}
}
print OUTPUT "\nError Count : $errorcount\n";
}
}
}
There are several problems with your code to start off.
ALWAYS use strict; and use warnings;.
3 argument open is much less error prone. open ( my $fh, "<", $filename ) or die $!;
Always check open actually worked.
FH =~ doesn't do what you think it does.
range operator tests if you're between two chunks of text in code. This is particularly relevant for multi-line operations. If your error log isn't, then it's not what you need.
Assuming you've error data like this:
ERROR: something is broken.
WARNING: something might be broken.
INFO: not broken.
ERROR: still broken.
This code will do the trick:
use strict;
use warnings;
my $filetoparse = "myfile.txt";
my $outputfile = "errorlog.txt";
open( my $input, "<", $filetoparse ) or die $!;
open( my $output, ">", $outputfile ) or die $!;
my $count_of_errors = 0;
#set record delimiter
local $/ = " . \n";
while ( my $lines = <$input> ) {
$lines =~ s/^-----\w+ LOAD-----\n//g; #discard any 'being/end load' lines.
if ( $lines =~ m/^ERROR/ ) {
$count_of_errors++;
print {$output} $lines;
}
}
close ( $input );
close ( $output );
print "$count_of_errors errors found\n";
If you've multi-line error message, then you'll need a slightly different approach though.
I am trying to use Perl to create a program that will read in data for a file that is 40,000+ lines long and parse through each message to extract the error messages from it.
A sample of the data I am using looks like this:
--------All Messages---------
SUCCESS: data transferred successfully .
SUCCESS: data transferred successfully .
SUCCESS: data transferred successfully .
ERROR: there was an error transferring data .
SUCCESS: data transferred successfully .
SUCCESS: data transferred successfully .
SUCCESS: data transferred successfully .
ERROR: there was an error transferring the data and the error message spans
more than 1 line of code and may also contain newline characters as well .
SUCCESS: data transferred successfully .
SUCCESS: data transferred successfully .
SUCCESS: data transferred successfully .
---------END REPOSITORY---------
each message in the log has the following in common:
1) it starts with either SUCCESS or ERROR depending on the outcome
2) all messages will end with <whitespace><period><newline>
The following is code that I have written but for some reason I can't seem to debug it. Any help is greatly appreciated.
open(FH,$filetoparse);
{
# following line is supposed to change the delimiter for the file
$/ = " .";
# the follow statement will create an error log of all error messages in log and save it
# to a file named errorlog.txt
while(<FH>)
{
push (#msgarray, $_);
}
if ($outputtype == 1)
{
$outputfile="errorlog.txt";
open(OUTPUT,">>$outputfile");
$errorcount=0;
$errortarget="ERROR";
print OUTPUT "-----------Error Log-----------\n";
for ($i=0;$i<#msgarray;$i++)
{
if ($msgarray[$i] =~ /^$errortarget/)
{
print OUTPUT "$msgarray[$i]\n";
# print OUTPUT "next code is: \n";
$errorcount++;
}
print OUTPUT "\nError Count : $errorcount\n";
close (OUTPUT);
}
}
Add the newline character to your delimiter. Change:
$/ = " .";
to:
$/ = " .\n";
And if you want to remove the delimiter, you can chomp.
while(<FH>)
{
chomp;
push (#msgarray, $_);
}
The problem with setting $/ = " ." is that the lines you read will end at that closing dot, and the following line will start with the newline character after it. That means none of your lines except possibly the first will start with "ERROR" - they will start with "\nERROR" instead, and so your test will always fail
There are some other issues with your code that you will want to understand.
You must always use strict and use warnings, and declare all your variables with my as close as possible to their first point of use
You should always use lexical file handles with the three-parameter form of open. You also need to check the status of every open and put $! in the die string so that you know why it failed. So
open(FH,$filetoparse);
becomes
open my $in_fh, '<', $filetoparse or die qq{Unable to open "$filetoparse" for input: $!};
It is better to process text files line by line unless you have good reasons to read them into memory in their entirety — for instance, if you need to do multiple passes through the data, or if you need random access to the contents instead of processing them linearly.
It's also worth noting that, instead of writing
while ( <$in_fh> ) {
push #msgarray, $_;
}
you can say just
#msgarray = <$in_fh>;
which has exactly the same result
It is often better to iterate over the contents of an array rather than over its indices. So instead of
for ( my $i = 0; $i < #msgarray; ++$i ) {
# Do stuff with $msgarray[$i];
}
you could write
for my $message ( #msgarray ) {
# Do stuff with $message;
}
Here's a rewrite of your code that demonstrates these points
open my $in_fh, '<', $filetoparse
or die qq{Unable to open "$filetoparse" for input: $!};
{
if ( $outputtype == 1 ) {
my $outputfile = 'errorlog.txt';
my $errorcount = 0;
my $errortarget = 'ERROR';
open my $out_fh, '>>', $outputfile
or die qq{Unable to open "$outputfile" for output: $!};
print $out_fh "-----------Error Log-----------\n";
while ( <$in_fh> ) {
next unless /^\Q$errortarget/;
s/\s*\.\s*\z//; # Remove trailing detail
print $out_fh "$_\n";
++$errorcount;
}
print $out_fh "\nError Count : $errorcount\n";
close ($out_fh) or die $!;
}
}
The file handle OUTPUT is closed within the for loop which you access for every iteration after closing. Move it outside the loop and try it
The following is memory directory
Every directory need to enter it and modify the following three files :
hcell.list
SmicDR1T_cal40_log_ll_sali_p1mx_1tm_121825.drc
SmicSP1R_cal40_LL_sali_p1mtx_11182533.lvs
The above three file has content "TPSRAM_256X120" and I want to replace it with its own directory path name.
How should I do it?
SPRF_256X34 SPSRAM_128X30 SPSRAM_192X16 SPSRAM_240X48 SPSRAM_2944X72 SPSRAM_480X48 SPSRAM_512X8 SPSRAM_72X8 SPSRAM_960X60_WEM SROM_8192X8
command.log SPSRAM_1024X14 SPSRAM_128X64 SPSRAM_2048X17 SPSRAM_240X56 SPSRAM_304X128 SPSRAM_480X64 SPSRAM_5376X17 SPSRAM_8192X12 SPSRAM_960X8 SROM_960X26
filenames.log SPSRAM_1024X16 SPSRAM_152X8 SPSRAM_2048X8 SPSRAM_240X72 SPSRAM_32X64 SPSRAM_480X66 SPSRAM_5376X80 SPSRAM_8192X20 SPSRAM_960X80 TPSRAM_1920X9
mem_new.list SPSRAM_11520X28 SPSRAM_16384X34 SPSRAM_240X10 SPSRAM_240X8 SPSRAM_384X19 SPSRAM_480X96 SPSRAM_544X20 SPSRAM_8192X34 SPSRAM_960X96 TPSRAM_256X120
SPRF_240X20 SPSRAM_120X72 SPSRAM_16384X38 SPSRAM_240X152 SPSRAM_240X88 SPSRAM_4352X8 SPSRAM_496X44 SPSRAM_544X21 SPSRAM_8192X52 SROM_1024X16
SPRF_240X32 SPSRAM_120X80 SPSRAM_16384X40 SPSRAM_240X17 SPSRAM_240X9 SPSRAM_4480X8 SPSRAM_496X82 SPSRAM_5760X32 SPSRAM_8192X72 SROM_1440X14
SPRF_240X82 SPSRAM_120X88 SPSRAM_1920X56 SPSRAM_240X18 SPSRAM_240X96 SPSRAM_480X128 SPSRAM_496X86 SPSRAM_64X22 SPSRAM_8192X8 SROM_1888X26
SPRF_240X86 SPSRAM_1216X40 SPSRAM_1920X60 SPSRAM_240X22 SPSRAM_256X8 SPSRAM_480X144 SPSRAM_512X10 SPSRAM_64X24 SPSRAM_8192X9 SROM_4096X8
SPRF_240X86_WEM SPSRAM_1280X32 SPSRAM_1920X8 SPSRAM_240X34 SPSRAM_2688X8 SPSRAM_480X16 SPSRAM_512X17 SPSRAM_64X48 SPSRAM_960X24 SROM_512X16
SPRF_240X90 SPSRAM_128X16 SPSRAM_1920X9 SPSRAM_240X40 SPSRAM_2880X8 SPSRAM_480X32 SPSRAM_512X27 SPSRAM_720X12 SPSRAM_960X60 SROM_736X14
get all the directories:
set all_dir [glob -type d -nocomplain -dir $dirname *]
in foreach loop open your files: hcell.list, SmicDR1T_cal40_log_ll_sali_p1mx_1tm_121825.drc, SmicSP1R_cal40_LL_sali_p1mtx_11182533.lvs
set r [open [file join $dir hcell.list] r]
Now replace your content using regsub:
regsub "TPSRAM_256X120" $line [pwd]
To replace a value in a file with another, while writing that file back to the same file, you want code like this:
proc replaceValue {filename changeThis toThis {backupExtension ""}} {
set mapping [list $changeThis $toThis]
# Read and transform the file
set f [open $filename]
set content [string map $mapping [read $f]]
close $f
# Make backup if requested
if {$backupExtension ne ""} {
file rename $filename $filename$backupExtension
}
# Write the new contents back
set f [open $filename "w"]
puts -nonewline $f $content
close $f
}
This is only suitable for files up to a couple of hundred megabytes (assuming you've got plenty of memory) but it is easy.
Then, to apply the alteration to everything in a directory, use glob to list the directory contents, foreach to go over the list, and that procedure to apply the transformation.
# Glob patterns in quotes just because of Markdown formatting bug
foreach filename [glob -directory /the/base/directory "*/*.list" "*/*.drc" "*/*.lvs"] {
# Make backups into .bak
replaceValue $filename TPSRAM_256X120 $filename ".bak"
}