I need to check whether any of a set of directories exist in a Perl script. The directories are named in the format XXXX*YYY - I need to check for each XXXX and enter an if statement if true.
In my script I have two variables $monitor_location (contains the path to the root directory being scanned) and $clientid (contains the XXXX).
The code snippet below has been expanded to show more of what I'm doing. I have a query which returns each client ID, I'm then looping for each record returned and trying to calculate the disk space used by that client ID.
I have the following code so far (doesn't work):
# loop for each client
while ( ($clientid, $email, $name, $max_record) = $query_handle1->fetchrow_array() )
{
# add leading zeroes to client ID if needed
$clientid=sprintf"%04s",$clientid;
# scan file system to check how much recording space has been used
if (-d "$monitor_location/$clientid\*") {
# there are some call recordings for this client
$str = `du -c $monitor_location/$clientid* | tail -n 1 2>/dev/null`;
$str =~ /^(\d+)/;
$client_recspace = $1;
print "Client $clientid has used $client_recspace of $max_record\n";
}
}
To be clear, I want to enter the if statement if there are any folders that start with XXXX.
Hope this makes sense! Thanks
You can use glob to expand the wildcard:
for my $dir (grep -d, glob "$monitor_location/$clientid*") {
...
}
I have a "thing" against glob. (It seems to only work once (for me), meaning you couldn't re-glob that same dir again later in the same script. It's probably just me, though.)
I prefer readdir(). This is definitely longer, but it WFM.
chdir("$monitor_location") or die;
open(DIR, ".") or die;
my #items = grep(-d, grep(/^$clientid/, readdir(DIR)));
close(DIR);
Everything in #items matches what you want.
Related
I am trying to write a script that looks at a .txt file and determins if the first number is greater or equal to 100. If it is then send an email, if it is not, do nothing.
Here is an example of what the .txt file would look like
vi output.txt
108
since that number is over 100 it should send an email of the number:
Example of email
You have 108 errors
This is what I got so far:
#!/bin/bash
filename = '/home/tted01/SPOOL/error.txt'
while read -r line
do
id = $(cut -c-3 <<< "$line")
echo $id >> /home/tted01/SPOOL/output.txt
done < "$filename"
mailx -s "ERRORS" ted.neal#gmail.com -- -f ted.neal#gmail.com < /home/tted01/SPOOL/output.txt
sleep 5
exit 0
I can't figure out the conditional statement and how to parse the variable.
Here is a simple Perl script. Since we need to both send a message and a file, the example from the question is changed to attach the file. This seems suitable with a small text file, which content is discussed in the body anyway. There are other ways to do this with mailx, see man mailx on your system.
use warnings;
use strict;
my $file = '/home/tted01/SPOOL/error.txt';
my $mark = 100;
# Slurp the whole file into a variable
my $cont = do {
open my $fh, '<', $file or die "Can't open $file -- $!";
local $/;
<$fh>;
};
# Pull the first number
my ($num) = $cont =~ /^(\d+)/;
if ($num > $mark)
{
my $body = "You have $num errors.";
my $cmd_email = "echo $body | " .
"mailx -a $file -s \"ERROR\" ted.neal\#gmail.com";
system($cmd_email) == 0 or die "Error sending email -- $!";
}
Since this is clearly a small enough file it is read in one go, into a variable. We extract the very first number that was in the file by a simple regex. (A "number" is understood as consecutive digits, up to anything other than a digit.)
The email command is executed via system, which in Perl uses sh. Perl's system returns a 0 if a command was executed without errors so we test against that. Note that this doesn't tell us how the command itself did, only whether it ran fine. All this can be done in other ways, if needed -- one can use backticks (qx) to get back the output, with possible stream redirection in the command to get the error as well. Also, bash can be invoked explicitly if needed.
Here is another option for how to compose the message. If the file is indeed so small, you can include its content in the message body.
Everything before and after this snippet stays as above.
my ($num) = $cont =~ /^(\d+)/;
chomp($cont);
my $body = "You have $num errors. Log file: $file. Content: $cont";
my $cmd_email = "echo $body | mailx -s \"ERROR\" ted.neal\#gmail.com";
Note that here we have to be careful with newlines, thus the chomp and no newlines in the message body. So this is pushing it a little.
If the log file may or may not be too large, you can check the number of lines and perhaps include the first 5 or 10 (and attach the file), or include the whole file as above (if small enough). This is easy to process in Perl. You can refine this further a lot. Finally, if things grow and get sophisticated you can use Perl modules for email.
A very reasonable question came up -- what if the number is not the very first thing in the file? What if it is the first thing on the second line, for example?
If the file is small, one can still read it into a variable like above and use a (more complicated) regex to find the pattern. For example, if the number is the first thing on the second line
my ($num) = $cont =~ /.*\n(\d+)/;
The pattern matches the newline directly by \n and captures the first number after it. Since there is no /s or such modifiers, a newline is not matched by . so the greedy .* does stop at the first newline, as needed.
However, this gets nastier very rapidly as more complicated requirements come. So better just process line by line.
# Instead of reading all content into $cont
open my $fh, '<', $file or die "Can't open $file -- $!";
my $num;
while (my $line = <$fh>)
{
if ($. == 2) { # $. is number of lines read
($num) = $line =~ /^(\d+)/;
last; # we are done, quit the loop
}
}
# Process the same way as above
We use one of Perl's built-in special variables, $., which holds the number of lines having been read from the (last accessed) filehandle. See Special Variables in perlvar. Note that the line is read at <>, so inside the loop $. is 1 when we are processing the first line, etc. The regex is the same, and here is an explanation that is missing above.
The match $line =~ m/.../ always returns a list of matches since it can match many times, so we 'catch' it in a list, using (). Since there is clearly just one here it is enough to use one variable, thus ($num). The m/ may be omitted and you'll generally see it that way, =~ /.../.
This is a simple condition, that it's the second line. But this way you can use far more sophisticated ones as well.
Here you have bash script solution:-
#!/bin/bash
filename = '/home/tted01/SPOOL/error.txt'
while read -r line;
do
id =`echo $line`
if [ $id -gt 100 ]; then
mailx -s "You have $id errors" ted.neal#gmail.com < /home/tted01/SPOOL/output.txt
fi
sleep 5
done < filename
Sample file:
### Current GPS Coordinates ###
Just In ... : unknown
### Power Source ###
2
### TPM Status ###
0
### Boot Version ###
GD35 1.1.0.12 - built 14:22:56, Jul 10 232323
I want split above file in to arrays like below:
#Current0_PS_Coordinates should be like below
### Current GPS Coordinates ###
Just In ... : unknown
I like to do it in Perl any help? (current program added from comment)
#!/usr/local/lib/perl/5.14.2 -w
my #lines;
my $file;
my $lines;
my $i;
#chomp $i;
$file = 'test.txt'; # Name the file
open(INFO, $file); # Open the file
#lines = <INFO>; # Read it into an array
close(INFO); # Close the file
foreach my $line (#lines) { print "$line"; }
Read the file line by line. Use chomp to remove trailing newlines
If the input line matches this regexp /^### (.*) ###/ then you have the name of an "array" in $1
It is possible to make named variables like #Current0_PS_Coordinates from these matches.
But it's better to use them as hash keys and then store the data in a hash that has arrays as it's values
So put the $1 from the match in "$lastmatch" and start an empty array referred to by a hash like this $items{$lastmatch}=[] for now and read some more
If the input line does not match the "name of an array" regexp given above and if it is not empty then we assume that it is a value for the last match found. So it can be stuffed in the current array like this push #$items{$lastmatch}, $line
Once you've done this all the data will be available in the %items hash
See the perldata, perlre, perldsc and perllol documentation pages for more details
A good place to start would be buying the book Learning Perl (O'Reilly). Seriously, it's a great book with interesting exercises at the end of each chapter. Very easy to learn.
1). Why do you have "my #lines" then "my $lines" lower down? I don't even think you're allowed to do that because scalars and arrays are the same variable but different context. For example, #list can be ('a', 'b', 'c') but calling $list would return 3, the number of items in that list.
2). What is "my $i"? Even if you're just writing down thoughts, try to use descriptive names. It'll make the code a lot easier to piece together.
3). Why is there a commented out "chomp $i"? Where were you going with that thought?
4). Try to use the 3 argument form of open. This will ensure you don't accidentally destroy files you're reading from:
open INFO, "<", $file;
If you're not sure where to start this problem, Vorsprung's answer probably won't mean anything. Regex and variables like $1 are things you'll need to read a book to understand.
My Linux system mounts some Samba shares, and some files are deposited by Windows users. The names of these files sometimes contain spaces and other undesirable characters. Changing these characters to hyphens - seems like a reasonable solution. Nothing else needs to be changed to handle these cleaned file names.
A couple of questions,
What other characters besides spaces, parenthesis should be translated?
What other file attributes (besides file type (file/dir) and permissions) should be checked?
Does Perl offer a pushd/popd equivalent, or is chdir a reasonable solution to traversing the directory tree?
This is my Perl program
#!/bin/env perl
use strict;
use warnings;
use File::Copy;
#rename files, map characters (not allowed) to allowed characters
#map [\s\(\)] to "-"
my $verbose = 2;
my $pat = "[\\s\\(\\)]";
sub clean {
my ($name) = #_;
my $name2 = $name;
$name2 =~ s/$pat/\-/g;
#skip when unchanged, collision
return $name if (($name eq $name2) || -e $name2); #skip collisions
print "r: $name\n" if ($verbose > 2);
rename($name, $name2);
$name2;
}
sub pDir {
my ($obj) = #_;
return if (!-d $obj);
return if (!opendir(DIR, $obj));
print "p: $obj/\n" if ($verbose > 2);
chdir($obj);
foreach my $dir (readdir DIR) {
next if ($dir =~ /^\.\.?$/); #skip ./, ../
pDir(clean($dir));
}
close(DIR);
chdir("..");
}
sub main {
foreach my $argv (#ARGV) {
print "$argv/\n" if ($verbose > 3);
$argv = clean($argv);
if (-d $argv) { pDir($argv); }
}
}
&main();
These posts are related, but don't really address my questions,
Use quotes: How to handle filenames with spaces? (using other scripts, prefer removing need for quotes)
File::Find perl script to recursively list all filename in directory (yes, but I have other reasons)
URL escaping: Modifying a Perl script which has an error handling spaces in files (not urls)
Quotemeta: How can I safely pass a filename with spaces to an external command in Perl? (not urls)
Here's a different way to think about the problem:
Perl has a built-in rename function. You should use it.
Create a data structure mapping old names to new names. Having this data will allow various sanity checks: for example, you don't want cleaned names stomping over existing files.
Since you aren't processing the directories recursively, you can use glob to good advantage. No need to go through the hassles of opening directories, reading them, filtering out dot-dirs, etc.
Don't invoke subroutines with a leading ampersand (search this issue for more details).
Many Unix-like systems include a Perl-based rename command for quick-and-dirty renaming jobs. It's good to know about even if you don't use it for your current project.
Here's a rough outline:
use strict;
use warnings;
sub main {
# Map the input arguments to oldname-newname pairs.
my #renamings =
map { [$_, cleaned($_)] }
map { -f $_ ? $_ : glob("$_/*") }
#_;
# Sanity checks first.
# - New names should be unique.
# - New should not already exist.
# - ...
# Then rename.
for my $rnm (#renamings){
my ($old, $new) = #$rnm;
rename($old, $new) unless $new eq $old;
}
}
sub cleaned {
# Allowed characters: word characters, hyphens, periods, slashes.
# Adjust as needed.
my $f = shift;
$f =~ s/[^\w\-\.\/]/-/g;
return $f;
}
main(#ARGV);
Don't blame Windows for your problems. Linux is much more lax, and the only character it prohibits from its file names is NUL.
It isn't clear exactly what you are asking. Did you publish your code for a critique, or are you having problems with it?
As for the specific questions you asked,
What other characters besides spaces, parenthesis should be translated?
Windows allows any character in its filenames except for control characters from 0x00 to 0x1F and any of < > \ / * ? |
DEL at 0x7F is fine.
Within the ASCII set, that leaves ! # $ % & ' ( ) + , - . : ; = # [ ] ^ _ ` { } ~
The set of characters you need to translate depends on your reason for doing this. You may want to start by excluding non-ASCII characters, so your code should read something like
$name2 =~ tr/\x21-\x7E/-/c
which will change all non-ASCII characters, spaces and DEL to hyphens. Then you need to go ahead and fix all the ASCII characters that you consider undersirable.
What other file attributes (besides file type (file/dir) and permissions) should be checked?
The answer to this has to be according to your purpose. If you are referring only to whether renaming a file or directory as required is possible, then I suggest that you just let rename itself tell you whether it succeeded. It will return a false value if the operation failed, and the reason will be in $!.
Does Perl offer a pushd/popd equivalent, or is chdir a reasonable solution to traversing the directory tree?
If you want to work with that idiom, then you should take a look at File::pushd, which allows you to temporarily chdir to a new location. A popd is done implicitly at the end of the enclosing block.
I hope this helps. If you have any other specific questions then please make them known by editing your original post.
I have the following CGI script that launches a module that creates a PNG file and then shows it.
#!/usr/bin/perl
use RRDs;
use CGI;
main:
{
my $cgi = new CGI;
my $filename = $cgi->param('filename');
print "Content-type: text/html\n\n";
my $curr_time = time();
my $start_time = $curr_time-3600;
RRDs::graph("$filename", "--start", "$start_time", "DEF:DiskC=c.rrd:DiskC:AVERAGE", "AREA:DiskC#0000FF");
my $err = RRDs::error();
print "<HTML><HEAD><TITLE>Disk C Utilization</TITLE></HEAD><BODY><H1>Disk C Utilization</H1><BR>$err<img src=\"$filename\"/></BODY></HTML>";
}
The graph method says that can't create the PNG file. If I run this script in a command like it works fine so I think it's a matter of permissions. I already set chmod 755 on the cgi-script folder. What do you suggest? Is this related to Apache2 settings?
Um, check the logs :) CGI Help Guide
$filename is not the filename that you want to use , it can be anything the browser sends, even F:/bar/bar/bar/bar/bar/bar/bar/UHOH.png
Its unlikely that F:/bar/bar/bar/bar/bar/bar/bar/UHOH.png exists on your server
You want to generate a filename, maybe like this
sub WashFilename {
use File::Basename;
my $basename = basename( shift );
# untainted , only use a-z A-Z 0-9 and dot
$basename = join '', $basename =~ m/([.a-zA-Z0-9])/g;
# basename is now, hopefully, file.ext
## so to ensure uniqueness, we adulterate it :)
my $id = $$.'-'.time;
my( $file, $ext ) = split /\./, $basename, 2 ;
return join '.', grep defined, $file, $id, $ext;
} ## end sub WashFilename
You also want to place the file in a directory of your webserver that will serve images (NOT cgi-bin)
And you also want to use File::Type::WebImages to determine web image file types using magic and make sure the filename has the appropriate extension , so your server will send the appropriate headers
And don't forget to chmod the file appropriately
chmod 777 solved my problem!
Don't store a document to file unless you have a reason to: it's slow and introduces all kinds of potential hazards.
You don't appear to reuse the same image on different requests, which might be such a reason.
Instead, teach your CGI script to output the image directly, depending on how it is called (or write a second one that does).
I need to export a table in the database to a tab separated values file. I am using DBI on Perl and SQLPlus. Does it support (DBI or SQLPlus) exporting and importing to or from TSV files?
I can write a code to do my need, But I would like to use a ready made solution if it is available.
It should be relatively simple to dump a table to a file with tab-separated values.
For example:
open(my $outputFile, '>', 'myTable.tsv');
my $sth = $dbh->prepare('SELECT * FROM myTable');
$sth->execute;
while (my $row = $sth->fetchrow_arrayref) {
print $outputFile join("\t", #$row) . "\n";
}
close $outputFile;
$sth->finish;
Note that this will not work well if your data contains either a tab or a newline.
From the information you have provided I am guessing you are using DBI to connect to an Oracle instance (since you mentioned sqlplus).
If you want a "ready made" solution as you have indicated, your best bet is to use "yasql" (Yet Another SQLplus) a DBD::Oracle based database shell for oracle.
yasql has a neat feature that you can write an sql select statement and redirect the output to a CSV file directly from its shell (You need Text::CSV_XS) installed for that.
On the other hand you can roll your own script with DBD::Oracle and Text::CSV_XS. Once your statement handles are prepared and executed, all you need to do is:
$csv->print ($fh, $_) for #{$sth->fetchrow_array};
Assuming you have initialised $csv with tab as record separator. See the Text::CSV_XS Documentation for details
Here's an approach with awk and sqlplus only. You can use store the awk script or copy/paste the oneliner. It uses the HTML output mode so that fields are not clobbered.
Store this script as sqlplus2tsv.awk:
# This requires you to use the -M "HTML ON" option for sqlplus, eg:
# sqlplus -S -M "HTML ON" user#sid #script | awk -f sqlplus2tsv.awk
#
# You can also use the "set markup html on" command in your sql script
#
# Outputs tab delimited records, one per line, without column names.
# Fields are URI encoded.
#
# You can also use the oneliner
# awk '/^<tr/{l=f=""}/^<\/tr>/&&l{print l}/^<\/td>/{a=0}a{l=l$0}/^<td/{l=l f;f="\t";a=1}'
# if you don't want to store a script file
# Start of a record
/^<tr/ {
l=f=""
}
# End of a record
/^<\/tr>/ && l {
print l
}
# End of a field
/^<\/td>/ {
a=0
}
# Field value
# Not sure how multiline content is output
a {
l=l $0
}
# Start of a field
/^<td/ {
l=l f
f="\t"
a=1
}
Didn't test this with long strings and weird characters, it worked for my use case. An enterprising soul could adapt this technique to a perl wrapper :)
I have had to do that in the past... I have a perl script that you pass the query you wish to run and pipe that through sqlplus. Here is an excerpt:
open(UNLOAD, "> $file"); # Open the unload file.
$query =~ s/;$//; # Remove any trailng semicolons.
# Build the sql statement.
$cmd = "echo \"SET HEAD OFF
SET FEED OFF
SET COLSEP \|
SET LINES 32767
SET PAGES 0
$query;
exit;
\" |sqlplus -s $DB_U/$DB_P";
#array = `$cmd`; # Execute the sql and store
# the returned data in "array".
print $cmd . "\n";
clean(#array); # Remove any non-necessary whitespace.
# This is a method to remove random non needed characters
# from the array
foreach $x (#array) # Print each line of the
{ # array to the unload file.
print UNLOAD "$x\|\n";
}
close UNLOAD; # Close the unload file.
Of course above I am making it pipe delimeted... if you want tabs you just need the \t instead of the | in the print.