How to exclude or not print previous found entries in script - perl

Can someone shed some light on how to have my script kick off only if new entries are found for the current hour? Our logs are based in 00 01 02, etc.
When this runs it will look for any accounts specified within my for loop and send an email if this particular user made a cert change for the hour. If a match is found then everything is fine.
But I am interested only in new real-time entries which I can't figure out.
This will be run from a cron, and I can't have it repeating the same entry. I am new to Perl and can't seem to figure this out.
I have tried the File::Tail module and other CPAN mods but due to company policies some mods are not allowed.
#!/usr/bin/perl -w
use strict;
my $flag = 0;
my $few = shift || 1;
my $id;
my $newline;
my $partyId;
my $userid;
my $tid;
my $infile;
my #Takeraccounts = ( 'SCN', 'CX' );
my $mail_dest = 'xxxxx#cx.com';
my %TIME;
(
$TIME{SEC}, $TIME{MIN}, $TIME{HOUR}, $TIME{MDAY}, $TIME{MON},
$TIME{YEAR}, $TIME{WDAY}, $TIME{YDAY}, $TIME{ISDST}
) = localtime(time);
my $OLD_MIN = $TIME{MIN};
my $OLD_HOUR = $TIME{HOUR};
my $cmd = "cat /raid/logs/`date +%H`";
my $out_file = "/home/resource/certchange.txt";
open FF, "$cmd |";
open( OUT, ">> $out_file" ) || die "Cannot open $out_file"; # temp file to which to write the formated output
while ( <FF> ) {
my $line = $_;
#chomp ($now_time);
$line =~ s/\n/ /;
if ( /Updating cert/ .. /,permissions/ ) {
$newline = "$line";
if ( $line =~ /Updating cert.*updated by (\w+)/ ) {
$id = $1;
}
if ( $newline =~ /UPDATE.*id:(\w+).*partyId:(\w+),perm:/ ) {
$userid = $1;
$partyId = $2;
foreach (#Takeraccounts) {
if ( $partyId =~ /$_/ ) {
print OUT "Certificate cert Updated by $id for userid $userid, PartyID $partyId\n";
open ML, "| mutt -e\"set realname='Support'; set use_from=yes; set from='support\#cx.com'; set envelope_from=yes\" -s ' Alert! cert CHANGED' -i $out_file -- $mail_dest";
close ML;
}
}
}
}
}
close FF;
close(OUT);
unlink $out_file;

Related

how to replace specific line by write appending to file

i have two files . one is user's input file and another file is original config file. After comparing two files , do add/delete functions in my original config file.
user's input file: (showing line by line)
add:L28A:Z:W #add--> DID ID --> Bin ID
del:L28C:B:Q:X:
rpl:L38A:B:M:D:
original input file
L28A:B:Q:M:X:
L28C:B:Q:M:X:
L38A:B:Q:M:X:
based on user's input file , first is doing add function second is delete function and third is replace function.
so output for original input txt file should show:
L28A:B:Q:M:X:Z:W
L28C:M:
L38A:B:M:D:
but my code is showing :
L28A:B:Q:M:X:
L28C:B:Q:M:X:
L38A:B:Q:M:X:
L28A:B:Q:M:X:Z:W
L28C:M:
L38A:B:M:D:
how can i replace above three lines with new modify lines?
use strict;
use warnings;
use File::Copy;
use vars qw($requestfile $requestcnt $configfile $config2cnt $my3file $myfile3cnt $new_file $new_filecnt #output);
my $requestfile = "DID1.txt"; #user's input file
my $configfile = "DID.txt"; #original config file
my $new_file = "newDID.txt";
readFileinString($requestfile, \$requestcnt);
readFileinString($configfile, \$config2cnt);
copy($configfile, $new_file) or die "The copy operation failed: $!";
while ($requestcnt =~ m/^((\w){3})\:([^\n]+)$/mig) #Each line from user request
{
my $action = $1;
my $requestFullLine = $3;
while ($requestFullLine =~ m/^((\w){4})\:([^\n]+)$/mig) #Each line from user request
{
my $DID = $1; #DID
my $requestBinList = $3; #Bin List in user request
#my #First_values = split /\:/, $requestBinList;
if ($config2cnt =~ m/^$DID\:([^\n]+)$/m) #configfile
{
my $ConfigFullLine = $1; #Bin list in config
my $testfile = $1;
my #First_values = split /\:/, $ConfigFullLine;
my #second_values = split /\:/, $requestBinList;
foreach my $sngletter(#second_values) # Each line from user request
{
if( grep {$_ eq "$sngletter"} #First_values)
{
print " $DID - $sngletter - Existing bin..\n\n";
}
else
{
print "$DID - $sngletter - Not existing bin..\n\n";
}
}
print "Choose option 1.Yes 2.No\n";
my $option = <STDIN>;
if ($option == 1) {
open(DES,'>>',$configfile) or die $!;
if($action eq 'add')
{
$ConfigFullLine =~ s/$/$requestBinList/g;
my $add = "$DID:$ConfigFullLine";
print DES "$add\n" ;
print"New Added Bin Valu $add\n\n";
}
if ( $action eq 'del')
{
foreach my $sngletter(#second_values){
$ConfigFullLine =~ s/$sngletter://g;
}
print DES "$DID:$ConfigFullLine\n";
print "New Deleted Bin Value $DID:$ConfigFullLine\n\n";
}
if ( $action eq 'rpl')
{
my $ConfigFullLine = $requestBinList;
my $replace = "$DID:$ConfigFullLine";
print DES "$replace\n";
print"Replace Bin Value $replace\n\n";
}
}
elsif ($option == 2)
{
print"Start from begining\n";
}
else
{
print "user chose invalid process or input is wrong\n";
}
}
else
{
print "New DID $DID detected\n";}
}
}
sub readFileinString
{
my $File = shift;
my $string = shift;
use File::Basename;
my $filenames = basename($File);
open(FILE1, "<$File") or die "\nFailed Reading File: [$File]\n\tReason: $!";
read(FILE1, $$string, -s $File, 0);
close(FILE1);
}
The problem is here:
open(DES,'>>',$configfile) or die $!;
You open your file for appending. So you get the original data, followed by your edited data.
Update: It appears that you have a working solution now, but I thought it might be interesting to show you how I would write this.
This program is a Unix filter. That is, it reads from STDIN and writes to STDOUT. I find that far more flexible than hard-coded filenames. You also don't have to explicitly open files - which saves time :-)
It also takes a command-line option, -c, telling it which file contains the edit definitions. So it is called like this (assuming we've called the program edit_files:
$ edit_files -c edit_definitions.txt < your_input_file > your_output_file
And here's the code.
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Std;
my %opts;
getopts('e:', \%opts);
my %edits = read_edits($opts{e});
while (<>) {
chomp;
my ($key, $val) = split /:/, $_, 2; #/ stop faulty syntax highlight
if (!exists $edits{$key}) {
print "$_\n";
next;
}
my $edit = $edits{$key};
if ($edit->[0] eq 'add') {
print "$_$edit->[1]\n";
} elsif ($edit->[0] eq 'del') {
$val =~ s/$_:// for split /:/, $edit->[1]; #/
print "$key:$val\n";
} elsif ($edit->[0] eq 'rpl') {
print "$key:$edit->[1]\n";
} else {
warn "$edit->[0] is an invalid edit type\n";
next;
}
}
sub read_edits {
my $file = shift;
open my $edit_fh, '<', $file or die $!;
my %edits;
while (<$edit_fh>) {
chomp;
# Remove comments
s/\s*#.*//; #/
my ($type, $key, $val) = split /:/, $_, 3; #/
$edits{$key} = [ $type, $val ];
}
}

Perl subroutine not running when script executed from Nagios XI back-end

I have a Perl script that is executed from Nagios XI.
It has two subroutines: SendEmail and SendTraps.
The script works fine when executed manually by passing the required parameters, but it doesn't work when triggered from Nagios. The script gets executed but the subroutines are skipped.
echo is working, but the two subroutines are not working even if the condition is met.
if ( ( $hoststatetype =~ m/HARD/ ) && ( $hoststate =~ m/DOWN/ ) ) {
`echo "HOST::$prihost $hostoutput">>/tmp/failover_log.txt`;
sendMail();
send_trap();
}
Full script here:
use strict;
use warnings;
use Text::CSV;
# Declared all the variables here
# Parsing input arguments
if ( $#ARGV > -1 ) {
if ( $ARGV[0] eq "-nagiosxi_trigger" ) {
$prihost = $ARGV[1];
$hoststate = $ARGV[2];
$hoststatetype = $ARGV[3];
$hostoutput = $ARGV[4];
}
elsif ( $ARGV[0] eq "-manual_trigger" ) {
$comment = $ARGV[1];
$userid = $ARGV[2];
$flag = "Failover-Trigger_Manual";
print "Maunal Failover triggered with comment: $comment by $userid\n";
$error_desc = "Maunal Failover triggered with comment: $comment by $userid";
send_trap();
sendMail();
exit 0;
}
else {
print STDERR "Invalid parameter $ARGV[0] \n";
exit 1;
}
}
else {
print STDERR "ERROR:No Arguments Passed.\n";
exit 1
}
# Check if Host or Service is in Hard/down state
if ( ( $hoststatetype =~ m/HARD/ ) && ( $hoststate =~ m/DOWN/ ) ) {
`echo "HOST::$prihost $hostoutput">>/tmp/failover_log.txt`;
sendMail();
send_trap();
}
elsif ( ( $hoststatetype =~ m/SOFT/ ) && ( $hoststate =~ m/DOWN/ ) ) {
`echo "HOST::$prihost $hostoutput">>/tmp/failover_log.txt`;
}
else {
`echo "HOST Good, $prihost $hostoutput">>/tmp/failover_log.txt`;
}
# Sub-Routines
sub failover {
my $csv = Text::CSV->new({ sep_char => ',' }) or die "Cannot use CSV: ".Text::CSV->error_diag ();;
my $file = "myxilist";
my $primary;
my $secondary;
#my $xienv;
my $host = `hostname`;
chomp $host;
open( my $data, '<', $file ) or die "Could not open '$file' $!\n";
while ( my $xi = <$data> ) {
chomp $xi;
if ( $csv->parse($xi) ) {
my #fields = $csv->fields();
if ( $fields[0] =~ m/$host/ ) {
$primary = $fields[1];
$secondary = $fields[0];
$xienv = $fields[2];
}
elsif ( $fields[1] =~ m/$host/ ) {
$primary = $fields[0];
$secondary = $fields[1];
$xienv = $fields[2];
}
}
else {
warn "Line could not be parsed: $xi\n";
exit 1;
}
}
my $failovermsg="failover successful from $primary to $secondary server";
return $failovermsg;
}
sub sendMail {
# Build the list for mailing out results
my $mailSubject;
my $mailID = "test\#mail.com";
my #results = failover();
$mailSubject = "Failover Successful on $xienv instance";
print "Sending email to $mailID \n";
`echo "sending Email">>/tmp/failover_log.txt`;
open MAILX, "|/usr/bin/mailx -s \"$mailSubject\" $mailID " or die $!;
print MAILX "#results";
close MAILX;
return;
}
sub send_trap {
# Sending SNMP traps
my #results = failover();
my $trap = `/usr/bin/snmptrap -v 2c -c public tcp:server:1010 '' MIB::Event Hostname s "$xienv" nSvcDesc s "$flag" nSvcStateID i 2 nSvcOutput s "#results"`;
return;
}
Any thoughts what could be missing?
Issue was in the failover() SubRoutine. I was calling a file "myxilist" that was present in the same directory as the script.
So, the script was working fine when called manually, but when it is triggered from application, script is getting executed from some other directory and the failover sub exits, as it's not able to open the file.
I've provided the full path of the file and the script works fine.
Thank you all for your help.

How to search no of strings from a no of text files In a given directory

I want to search my string Input at consol i.e. "VoLTE SIPTX: [SIPTX-SIP] ==> REGISTER" from the no of files In a directory (Sample data of the file Is shown below) but unable to do the same in the below code.
Here is my code:
use strict;
use warnings;
print "Entering the value i.e. the IMS Message to compare with";
my $value = '';
my $choice = '';
my $loop = '';
my $IMS_Message = '';
my $search = '';
my $kw = '';
print "\nThe script path & name is $0\n";
print "\nPlease enter desired number to select any of the following
(1) Start Comparing REGISTER message !!
(2) Start Comparing SUBSCRIBE message
(3) Start Comparing INVITE message \n";
$value = <STDIN>;
if ( $value == 1 ) {
print "\n Start Comparing REGISTER message\n\n";
$IMS_Message = "VoLTE SIPTX: [SIPTX-SIP] ==> REGISTER";
}
elsif ( $value == 2 ) {
print "\n SUBSCRIBE message Flow\n\n";
}
elsif ( $value == 3 ) {
print "\n INVITE message Flow\n\n";
}
else {
print "\nThe input is not valid!\n";
print "\nDo you want to continue selecting a Automation Mode again (Y or N)?\n";
$choice = <STDIN>;
if ( $choice eq /[Yy]/ ) {
test_loop();
}
else {
exit;
}
$kw = $IMS_Message;
#$search = qr/\Q$kw/;
$search = quotemeta( $kw );
for my $file ( grep {-f} glob '*main_log' ) {
open my $fh, '<', $file or die qq{Unable to open "$file" for input: $!};
while ( <$fh> ) {
if ( /$search/ ) {
printf "Found keyword %s in file %s, line %d: %s\n", $kw, $file, $., $_;
last;
}
}
}
}
Here is data of my files from which I want to search my string
**TempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTemp
*TempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTemp
VoLTE SIPTX: [SIPTX-SIP] ==> REGISTERTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTemp
tempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTemp
temptempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTemp
***tempTeTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTemp
the below code with command line does not work
use strict;
use warnings;
my $value = '';
my $choice = '';
my $loop = '';
my $IMS_Message = '';
print "\nThe script path & name is $0\n";
print "\nPlease enter desired number to select any of the following
(1) Start Comparing REGISTER message !! !!
(2) Start Comparing SUBSCRIBE message
(3) Start Comparing INVITE message \n";;
$value = <STDIN>;
if ($value == 1 )
{
print "\n Start Comparing REGISTER message\n\n";
my $IMS_Message = 'VoLTE SIPTX: [SIPTX-SIP] ==> REGISTER';
&IMS_Message_Check;
}
elsif ($value == 2)
{
print "\n SUBSCRIBE message Flow\n\n";
}
elsif ($value == 3)
{
print "\n INVITE message Flow\n\n";
}
else
{
print "\nThe input is not valid!\n";
print "\nDo you want to continue selecting a Automation Mode again (Y or N)?\n";
$choice = <STDIN>;
if( $choice =~ /[Yy]/) {
test_loop();
} else {
exit;
}
}
sub IMS_Message_Check{
print "\n";
print "Start Comparing REGISTER message\n\n";
#my $IMS_Message = 'VoLTE SIPTX: [SIPTX-SIP] ==> REGISTER';
my $kw = $IMS_Message;
my $search = qr/\Q$kw/;
for my $file ( grep { -f } glob '*main_log' ) {
open my $fh, '<', $file or die qq{Unable to open "$file" for input: $!};
while ( <$fh> ) {
if ( /$search/ ) {
printf "Found keyword %s in file %s, line %d: %s\n", $kw, $file, $., $_;
#last;
}
}
}
}
Okay, there are two main problems with your code
You have added my solution into the The input is not valid branch of your consecutive if statement. That is why I asked you to keep your code tidy and indented properly. You would have spotted it yourself if your indentation was at all organised
Your program is searching for VoLTE SIPTX: [SIPTX-SIP] ==> REGISTER while the text in the file is VoLTE SIPTX: [SIPTX-SIP] ==> REGISTER (your program has two spaces before REGISTER while your data has just one). Isn't that an obvious thing to check for?
I feel certain that you could have discovered these things for yourself, and you could certainly have read How to create a Minimal, Complete, and Verifiable example instead of posting very poor code and no sample data in the first place
I've ignored your command-line menu (which shouldn't be in the code at this stage anyway) including your call to the non-existent test_loop, and have written this, which performs properly. The bulk of it is a copy of the solution I provided to your previous question, which you said wasn't working
use strict;
use warnings;
print "\n";
print "Start Comparing REGISTER message\n\n";
my $IMS_Message = 'VoLTE SIPTX: [SIPTX-SIP] ==> REGISTER';
my $kw = $IMS_Message;
my $search = qr/\Q$kw/;
for my $file ( grep { -f } glob '*main_log' ) {
open my $fh, '<', $file or die qq{Unable to open "$file" for input: $!};
while ( <$fh> ) {
if ( /$search/ ) {
printf "Found keyword %s in file %s, line %d: %s\n", $kw, $file, $., $_;
last;
}
}
}
output
Start Comparing REGISTER message
Found keyword VoLTE SIPTX: [SIPTX-SIP] ==> REGISTER in file xmain_log, line 3: VoLTE SIPTX: [SIPTX-SIP] ==> REGISTERTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTempTemp

extracting regions from a range file in a formatted output perl

I have a input and list file like this:
input.txt file:
>gi|NP_415931.4
MTEQQKLTFTALQQRLDSLMLRDRLRFSRRLHGVKKVKNPDAQQAIFQEMAKEIDQAAGKVLLREAARPEITYPD
>gi|NP_418770.2
MMNKSNFEFLKGVNDFTYAIACAAENNYPDDPNTTLIKMRMFGEATAKHLGLL
>gi|YP_026226.4
MRKFTLNIFTLSLGLAVMPMVEAAPTAQQQLLEQVRLGEATHREDLVQQSLYRLELIDPNNPDVVAARFRSLLRQGDIDGAQKQ
list.txt file:
NP_415931.4: 1-5, 6-8
YP_026226.4: 3-7, 9-9, 10, 12-15
Now, for this time, I want a csv formatted output.csv (with certain added header) as (for the above inputs):
ID,Regions,Length,Sequences
NP_415931.4,1-5,5,MTEQQ
,6-8,3,KLT
YP_026226.4,3-7,5,KFTLN
,9-9,1,F
,10,1,T
,12-15,4,SLGL
that is, it first match the list file headers with those of input files and the matched once's sequences are taken and then it gives the output arranging in the above format.
the excel view of the output.csv would be:
How can I generate the above output.csv file from those inputs?
Thanks
Here is an approach. To summarize: We have a master database file input.txt with all defined sequences. Our job is to extract certain information from this database and write it to a CSV file. The information about what to extract is given in file list.txt.
use feature qw(say);
use strict;
use warnings;
my $input_fn = 'input.txt';
open ( my $fh1, '<', $input_fn ) or die "Could not open file '$input_fn': $!";
my %seqs;
while( my $line = <$fh1> ) {
my ($id ) = $line =~ /gi\|(.*)$/;
chomp( my $seq = <$fh1> );
$seqs{$id} = $seq;
}
close $fh1;
say join ',', qw(ID Regions Length Sequences);
my $list_fn = 'list.txt';
open ( my $fh2, '<', $list_fn ) or die "Could not open file '$list_fn': $!";
while( my $line = <$fh2> ) {
chomp $line;
my ( $id, #regions ) = split /[:,]\s?/, $line;
for my $i (0..$#regions) {
my $region = $regions[$i];
my $start = my $end = $region;
if ( $region =~ /(\d+)-(\d+)/ ) {
$start = $1;
$end = $2;
}
my $name = ($i == 0) ? $id : "";
my $seq = substr( $seqs{$id}, $start - 1, $end - $start + 1);
say join ',', $name, $region, length( $seq ), $seq;
}
}
close $fh2;
Output:
ID,Regions,Length,Sequences
NP_415931.4,1-5,5,MTEQQ
,6-8,3,KLT
YP_026226.4,3-7,5,KFTLN
,9-9,1,F
,10,1,T
,12-15,4,SLGL

Perl line/delimiter file formatting syntax

I'm trying to figure out how to use a code that's written in perl, but am not very familiar with perl syntax. I was wondering if someone could tell me what the format of the file #metafilecache is? The code is failing to read the samplerate within the file, but I'm not sure how I have it formatted incorrectly. Here's the excerpt of the code I think is appropriate:
my $tnet = $ARGV[0];
my $tsta = $ARGV[1];
my $stadir = $ARGV[2];
if ( ! -d "$targetdir" ) {
mkdir "$targetdir" || die "Cannot create $targetdir: $?\n";
}
die "Cannot find PDF bin base dir: $pdfbinbase\n" if ( ! -d "$pdfbinbase" );
my %targetdays = ();
my %targetchan = ();
# Collect target files in the $pdfbinbase dir, limited by $changlob
foreach my $nsldir (glob("$pdfbinbase/{CHRYS}/$tnet.$tsta.*")) {
next if ( ! -d "$nsldir" ); # Limit to directories
# Extract location ID from directory name
my ($net,$sta,$loc) = $nsldir =~ /\/(\w+)\.(\w+)\.([\w-]+)$/;
if ( $net ne $tnet ) {
print "Target network ($tnet) != network ($net)\n";
next;
}
if ( $sta ne $tsta ) {
print "Target station ($tsta) != station ($sta)\n";
next;
}
foreach my $chandir (glob("$nsldir/$changlob")) {
next if ( ! -d "$chandir" ); # Limit to directories
# Extract channel code from directory name
my ($chan) = $chandir =~ /.*\/([\w\d]+)$/;
foreach my $yeardir (glob("$chandir/Y*")) {
next if ( ! -d "$yeardir" ); # Limit to directories
# Extract year from directory name
my ($year) = $yeardir =~ /^.*\/Y(\d{4,4})$/;
foreach my $daybin (glob("$yeardir/D*.bin")) {
next if ( ! -f "$daybin" ); # Limit to regular files
my ($day) = $daybin =~ /^.*\/D(\d{3,3})\.bin$/;
$targetdays{"$loc.$chan.$year.$day"} = $daybin;
$targetchan{"$loc.$chan"} = 1;
}
}
}
}
if ( $verbose > 1 ) {
print "Target days from PDF bin files:\n";
my $count = 0;
foreach my $tday (sort keys %targetdays) {
print "Target day: $tday => $targetdays{$tday}\n";
$count++;
}
print "Targets: $count\n";
}
# Remove targets that have already been calculated by checking
# results files against targets.
foreach my $tchan ( keys %targetchan ) {
my ($loc,$chan) = split (/\./, $tchan);
# Generate target file name
my $targetfile = undef;
if ( $loc ne "--" ) { $targetfile = "$targetdir/$prefix-$loc.$chan"; }
else { $targetfile = "$targetdir/$prefix-$chan"; }
print "\nChecking target file for previous results: $targetfile\n"
if ( $verbose );
next if ( ! -f "$targetfile" );
# Open result file and remove any targets that are included
open IN, "$targetfile" || next;
foreach my $line (<IN>) {
next if ( $line =~ /^YEAR\.DAY/ );
my ($year,$day) = $line =~ /^(\d+).(\d+)/;
# Delete this target
delete $targetdays{"$loc.$chan.$year.$day"};
}
close IN;
}
if ( $verbose > 1 ) {
print "Remaining target days:\n";
my $count = 0;
foreach my $tday (sort keys %targetdays) {
print "Target day: $tday => $targetdays{$tday}\n";
$count++;
}
print "Remaining Targets: $count\n";
}
my %targetfiles = ();
# Calculate and store PDF mode for each target day
TARGET: foreach my $tday (sort keys %targetdays) {
my ($loc,$chan,$year,$day) = split (/\./, $tday);
my %power = ();
my %count = ();
my #period = ();
# Determine sampling rate
my $samprate = GetSampRate ($tnet,$tsta,$loc,$chan);
print "Samplerate for $tnet $tsta $loc $chan is: $samprate\n" if (
$verbose );
if ( ! defined $samprate ) {
if ( ($tsta eq "ECSD") || ($tsta eq "SFJ") || ($tsta eq "CASEE") ||
($tsta eq "JSC") ){
next;
}
else {
print "Cannot determine sample rate for channel
$tnet.$tsta.$loc.$chan\n";
next;
}
}
This is the subroutine GetSampRate:
sub GetSampRate { # GetSampRate (net,sta,loc,chan)
my $net = shift;
my $sta = shift;
my $loc = shift;
my $chan = shift;
my $samprate = undef;
# Generate source name: Net_Sta_Loc_Chan
my $srcname = "${net}_${sta}_";
$srcname .= ($loc eq "--") ? "_" : "${loc}_";
$srcname .= "$chan";
if ( $#metafilecache < 0 ) {
my $metafile = "$stadir/metadata.txt";
if ( ! -f "$metafile" ) {
print "GetSampRate(): Cannot find metadata file: $metafile\n";
return undef;
}
# Open metadata file
if ( ! (open MF, "<$metafile") ) {
print "GetSampRate(): Cannot open: $metafile\n";
return undef;
}
# Read all lines in the metafilecache
#metafilecache = <MF>;
close MF;
}
# Read all lines starting with srcname into #lines
my #lines = grep { /^$srcname/ } #metafilecache;
# Find maximum of sample rates for this channel
foreach my $line ( #lines ) {
my #fields = split(/\t/, $line);
my $rate = $fields[7];
$samprate = $rate if (!defined $samprate || $rate > $samprate);
}
return $samprate;
}
The code you have shown is very clunky.
As far this scope is concerned, the file is called $stadir/metadata.txt and I can't help with $stadir as it's either undefined or a global value that is set elsewhere — not a great design idea
After that, #metafilecache = <MF> loads the entire file into the array #metafilecache, leaving a trailing newline character at the end of each element
Then my #lines = grep { /^$srcname/ } #metafilecache duplicates to #lines all lines beginning with the string held in $srcname. This is another global variable that shouldn't be used
The following for loop splits the line on tab ("\t" or "\x09") separators and sets $rate to the eighth value ($fields[7]). $samprate is updated at each iteration if the latest value of $rate is greater than the current stored maximum
I hope that helps