Redirect of STDERR not closing - windows

I am redirecting STDERR to an error file but am unable to unlink the error file if it is empty. I believe that I am not releasing STDERR which is rendering the error file busy and cannot be deleted. What do you think? Thank you!
$errFile = $outFile . "-error";
open (ERRFILE, '>', $errFile) or die $!;
#Redirect STDERR from the console to the error log
open (STDERR, '>', $errFile) or die $!;
# Do stuff....
close(STDERR);
close(ERRFILE);
#Remove blank error files
opendir(DIR, 'c:\LMITS');
#errFiles = grep /error/, readdir DIR;
closedir DIR;
foreach $errFile (#errFiles) {
$errFileSize = -s $errFile;
if ($errFileSize == 0) {
unlink $errFile;
}
}

readdir returns file names, not paths.
foreach (#errFiles) {
my $errFile = 'c:\\LMITS\\' . $_;
...
}

This code works but if I move the commands to close SDTERR and ERRFILE down in the script any a blank ERRFILE will not be deleted. I'm ok for now but I will keep researching for the sake of just knowing.
use CQPerlExt;
use POSIX qw(strftime);
use Strict;
my $checkForBlanks;
my $dbConfig;
my $dbConfigRecord;
my $entitydef;
my $errFile;
my #errFiles;
my $errFileSize;
my $fileDate;
my #fieldNames;
my $fieldName;
my $lastSync;
my $outFile;
my $queryDef;
my $queryResults;
my $recordCount = 0;
my $recordType;
my $session;
my $scriptStartTime;
my $swCR;
my $swData;
my $swID;
# ##############################################
# ##### Process administrative items and
# ##### establish a ClearQuest session
# ##############################################
$scriptStartTime = strftime("%Y-%m-%d %I:%M:%S %p", localtime());
$fileDate = strftime("%Y%m%d_%I%M%S%p", localtime());
#Create and open the output and error files
$outFile = "MSTU_Unclass_Export"."_".$fileDate.".txt";
open (OUTFILE, ">", $outFile) or die $!;
$errFile = $outFile . "-error";
open (ERRFILE, '>', $errFile) or die $!;
#Redirect STDERR from the console to the error log
open (STDERR, '>', $errFile) or die $!;
$session = CQSession::Build();
CQSession::UserLogon($session, "uname", "pw", "db", "schema");
$dbConfigRecord = $session->GetEntity("DB_CONFIG", "33554467");
$lastSync = $dbConfigRecord->GetFieldStringValue("LastSyncDate");
# ##############################################
# ##### Query the database for all SWCRs
# ##### updated after lastSyncDate
# ##############################################
$queryDef = $session->BuildQuery("SWCR");
$queryDef->BuildField("dbid");
#lastSyncDate = ($lastSync);
$operator = $queryDef->BuildFilterOperator($CQPerlExt::CQ_BOOL_OP_AND);
$operator->BuildFilter ("history.action_timestamp", $CQPerlExt::CQ_COMP_OP_GTE,\#lastSyncDate);
$queryResults = $session->BuildResultSet($queryDef);
$queryResults->Execute();
# ##############################################
# ##### Build a text file with SWCR data associated
# ##### with the dbids returned above
# ##############################################
#Get all of the fieldnames you want to export
$recordType = 'SWCR';
$entitydef = $session->GetEntityDef($recordType);
#fieldNames = #{$entitydef->GetFieldDefNames()};
#Remove any fields you don't want
#fieldNames = grep ! /dbid|history|RecordID|CCObjects|MergeSWCRs|AssociatedIntegrationSet|Level1TestResults|
Level2TestResults|Level3TestResults|Level4TestResults|Reviews|WithdrawCR|
AssociatedWithdrawnCR|Attachments|AssociatedPRs|OriginatingSolution|AssociatedSWRsFull|
AssociatedSWRsDelta|ClonedFrom|ClonedTo|AssociatedComment|ExternalLinks|ratl_mastership/x, #fieldNames;
while ($queryResults->MoveNext() == $CQPerlExt::CQ_SUCCESS) {
$swCR = $session->GetEntityByDbId("SWCR", $queryResults->GetColumnValue(1));
#Gather data
$swID = $swCR->GetFieldValue("RecordID")->GetValue();
$swData = "<RecordID>" . $swID . "</RecordID>";
foreach $fieldName (#fieldNames)
{
$checkForBlanks = $swCR->GetFieldStringValue($fieldName);
if ($checkForBlanks ne ""){
$swData = $swData . "<" . $fieldName . ">" . $swCR->GetFieldStringValue($fieldName) . "</" . $fieldName . ">";
}
}
#Build file with records seperated by custom line delimiter
print OUTFILE $swData . "~~lineDelimiter~~\n";
#Keep track of the amount of records being exported
$recordCount++;
}
close(STDERR);
close(ERRFILE);
close(OUTFILE);
# ##############################################
# ##### Process administrative items and
# ##### close ClearQuest session
# ##############################################
#Remove extra carriage return at bottom of export file because this will throw an error when an import is performed
truncate($outFile, (-s $outFile) - 2);
#Add amount of records exported to the export log
open (EXPLOG, ">>", 'Export_Log.txt') or die $!;
print EXPLOG "$scriptStartTime: $recordCount record(s) written to $outFile for export.\n";
close (EXPLOG);
#Set the LastSyncDate field to the time the export script started
$dbConfigRecord = $session->GetEntity("DB_CONFIG", "33554467");
$session->EditEntity($dbConfigRecord, "Modify");
$dbConfigRecord->SetFieldValue("LastSyncDate",$scriptStartTime);
$dbConfigRecord->Validate();
$dbConfigRecord->Commit();
#Remove blank error files
opendir(DIR, 'c:\LMITS');
#errFiles = grep /error/, readdir DIR;
closedir DIR;
foreach $errFile (#errFiles) {
$errFileSize = -s $errFile;
if ($errFileSize == 0) {
unlink $errFile;
}
}
CQSession::Unbuild($session);

Related

Getting a compilation error on add data script

'''
#!/usr/bin/perl
# Add data to the database\n
use strict;
use DBI;
my $idmap = shift || die "file of <id,url> joined with tabs";
my $dir = shift || die "directory that contains the urls";
my $dbh = DBI->connect("dbi:SQLite:websites.db","","",{RaiseError=>, AutoCommit=>1});
$dbh->do("CREATE VIRTUAL TABLE webpages USING FTS3('id','url','contents');");
my $prep = $dbh->prepare ("INSERT INTO webpages (id, url, contents) VALUES (?,?,?);");
OPEN(IN, $idmap)|| die "Can't open $idmap";
while (<IN>){
chomp;
my ($id,$url) = split /\t/;
unless(-e "$dir/$id.html"){
print STDERR "Skipped $id\n";
}
open (HTML,"$dir/$id.html")||die"Can't open $dir/$id.html";
my $contents = join("",(<HTML>));
close HTML;
print SDTERR "Adding $id:$url to the database\n";
$prep->execute($id,$url,$contents)||die $dbh ->errstr;
}
'''
Bareword error on line 16. Cant resolve issue for days.

How can I reduce this to a single file open?

Using Strawberry Perl 5.22.0 in Windows 7. Is there a more "perlish" way to write this snippet of code? I hate the duplication of file open sections, but cannot think of a way to make it only open once because of the requirement to test the creation time.
...
my $x;
my $fh;
my $sentinelfile = "Logging.yes"; #if this file exists then enable logging
my $logfile = "transfers.log";
my $log = 0; #default to NO logging
$log = 1 if -e $sentinelfile; #enable logging if sentinel file exists
if($log){
#logfile remains open after this so remember to close at end of program!
if (-e $logfile) { #file exists
open($fh, "<", $logfile); #open for read will NOT create if not exist
chomp ($x = <$fh>); #grab first row
close $fh;
if (((scalar time - $x)/3600/24) > 30) { #when ~30 days since created
rename($logfile, $logfile . time); #rename existing logfile
open($fh, ">", $logfile); #open for write and truncate
print $fh time,"\n"; #save create date
print $fh "--------------------------------------------------\n";
} else { #file is not older than 30 days
open($fh, ">>", $logfile); #open for append
}
} else { #file not exist
open($fh, ">", $logfile); #open new for write
print $fh time,"\n"; #save create date
print $fh "--------------------------------------------------\n";
}
} #if $log
...
To recap: logfile logs stuff. First row of file contains the logfile creation date. Second row contains horizontal rule. Rest of file contains text. Around 30 days after file was created, rename file and start a new one. After the above chunk of code the logfile is open and ready for logging stuff. It gets closed at the end of the rest of the program.
There are other, non-cosmetic problems with your code: a) You do not ever check if your calls to open succeeded; b) You are creating a race condition. The file can come into existence after the -e check has failed. The subsequent open $fh, '>' ... would then clobber it; c) You don't check if your rename call succeeded etc.
The following would be a partial improvement on your existing code:
if ($log) {
if (open $fh, '<', $logfile) { #file exists
chomp ($x = <$fh>);
close $fh
or die "Failed to close '$logfile': $!";
if (((time - $x)/3600/24) > 30) {
my $rotated_logfile = join '.', $logfile, time;
rename $logfile => $rotated_logfile
or die "Failed to rename '$logfile' to '$rotated_logfile': $!";
open $fh, '>', $logfile
or die "Failed to create '$logfile'";
print $fh time, "\n", '-' x 50, "\n";
}
else {
open $fh, '>>', $logfile
or die "Cannot open '$logfile' for appending: $!";
}
}
else {
open $fh, '>', $logfile
or die "Cannot to create '$logfile': $!";
print $fh time, "\n", '-' x 50, "\n";
}
}
It would be better to abstract every bit of discrete functionality to suitably named functions.
For example, here is a completely untested re-write:
use autouse Carp => qw( croak );
use constant SENTINEL_FILE => 'Logging.yes';
use constant ENABLE_LOG => -e SENTINEL_FILE;
use constant HEADER_SEPARATOR => '-' x 50;
use constant SECONDS_PER_DAY => 24 * 60 * 60;
use constant ROTATE_AFTER => 30 * SECONDS_PER_DAY;
my $fh;
if (ENABLE_LOG) {
if (my $age = read_age( $logfile )) {
if ( is_time_to_rotate( $age ) ) {
rotate_log( $logfile );
}
else {
$fh = open_log( $logfile );
}
}
unless ($fh) {
$fh = create_log( $logfile );
}
}
sub is_time_to_rotate {
my $age = shift;
return $age > ROTATE_AFTER;
}
sub rotate_log {
my $file = shift;
my $saved_file = join '.', $file, time;
rename $file => $saved_file
or croak "Failed to rename '$file' to '$saved_file': $!"
return;
}
sub create_log {
my $file = shift;
open my $fh, '>', $file
or croak "Failed to create '$file': $!";
print $fh time, "\n", HEADER_SEPARATOR, "\n"
or croak "Failed to write header to '$file': $!";
return $fh;
}
sub open_log {
my $file = shift;
open my $fh, '>>', $file
or croak "Failed to open '$file': $!";
return $fh;
}
sub read_age {
my $file = shift;
open my $fh, '<', $file
or return;
defined (my $creation_time = <$fh>)
or croak "Failed to read creation time from '$file': $!";
return time - $creation_time;
}
If you need to read a line of a file, rename it and then work with it, you have to open it twice.
However, you can also do away with using that first line.
On Windows, according to perlport (Files and Filesystems), the inode change time time-stamp (ctime) "may really" mark the file creation time. This is likely to be completely suitable for a log file that doesn't get manipulated and moved around. It can be obtained with the -C file-test operator
my $days_float = -C $filename;
Now you can numerically test this against 30. Then there is no need to print the file's creation time to its first line (but you may as well if it is useful for viewing or other tools).
Also, there is the module Win32API::File::Time, with the purpose to
provide maximal access to the file creation, modification, and access times under MSWin32
Plese do read the docs for some caveats. I haven't used it but it seems tailored for your need.
A good point is raised in a comment: apparently the OS retains the original time-stamp as the file is being renamed. In that case, when the file's too old copy it into a new one (with the new name) and delete it, instead of using rename. Then open that log file anew, so with a new time-stamp.
Here is a complete example
archive_log($logfile) if -f $logfile and -C $logfile > 30;
open my $fh_log, '>>', $logfile or die "Can't open $logfile: $!";
say $fh_log "Log a line";
sub archive_log {
my ($file) = #_;
require POSIX; POSIX->import('strftime');
my $ts = strftime("%Y%m%d_%H:%M:%S", localtime); # 20170629_12:44:10
require File::Copy; File::Copy->import('copy');
my $archive = $file . "_$ts";
copy ($file, $archive) or die "Can't copy $file to $archive: $!";
unlink $file or die "Can't unlink $file: $!";
}
The archive_log archives the current log by copying it and then removes it.
So after that we can just open for append, which creates the file if not there.
The -C tests for file existence but since its output is used in a numerical test we need -f first.
Since this happens once a month I load modules at runtime, with require and import, once the log actually need be rotated. If you already use File::Copy then there is no need for this. As for the time-stamp, I threw in something to make this a working example.
I tested this on UNIX, by changing -C to -M and tweaking the timestamp by touch -t -c.
Better yet, to reduce the caller's code fully move the tests into the sub as well, for
my $fh_log = open_log($logfile);
say $fh_log "Log a line";
sub open_log {
my ($file) = #_;
if (-f $file and -C $file > 30) {
# code from archive_log() above, to copy and unlink $file
}
open my $fh_log, '>>', $file or die "Can't open $file: $!";
return $fh_log;
}
Note. On UNIX the file's creation time is not kept anywhere. The closest notion is the ctime above, but this is of course different. For one thing, it changes with many operations, for instance mv, ln, chmod, chown, chgrp (and probably others).

Keep shared entries among many files

I have hundreds of files, each with different number of entries (>xxxx) and want to keep only shared entries among all files, separately. I'm not sure what is the best method to do this, maybe perl! I used sort, uniq of bash, but I didn't get the correct answer. The format of IDs start with > and follows 4 characters among all files.
1.fa
>abcd
CTGAATGCC
2.fa
>abcd
AAATGCGCG
>efgh
CGTAC
3.fa
>abcd
ATGCAATA
>efgh
TAACGTAA
>ijkl
TGCAA
Final results, of this example would be:
1.fa
>abcd
CTGAATGCC
2.fa
>abcd
AAATGCGCG
3.fa
>abcd
ATGCAATA
This Perl program will do as you ask. It uses Perl's built-in edit in place functionality and renames the original files to 1.fa.bak etc. It shouldn't have a problem with blank lines in your data as long as the sequence is always on one line immediately following the ID
use strict;
use warnings 'all';
my #files = glob '*.fa';
printf "Processing %d file%s\n", scalar #files, #files == 1 ? "" : "s";
exit if #files < 2;
my %ids;
{
local #ARGV = #files;
while ( <> ) {
++$ids{$1} if /^>(\S+)/;
}
}
# remove keys that aren't in all files
delete #ids{ grep { $ids{$_} < #files } keys %ids };
my $n = keys %ids;
printf "%d ID%s common to all files\n", $n, $n == 1 ? '' : "s";
exit unless $n;
{
local #ARGV = #files;
local $^I = '.bak';
while ( <> ) {
next unless /^>(\S+)/ and $ids{$1};
print;
print scalar <>;
}
}
Here is Perl solution, that may help you:
use feature qw(say);
use strict;
use warnings;
my $file_dir = 'files';
chdir $file_dir;
my #files = <*.fa>;
my $num_files = scalar #files;
my %ids;
for my $file (#files) {
open ( my $fh, '<', $file) or die "Could not open file '$file': $!";
while (my $id = <$fh>) {
chomp $id;
chomp (my $sequence = <$fh>);
$ids{$id}++;
}
close $fh;
}
for my $file (#files) {
open ( my $fh, '<', $file) or die "Could not open file '$file': $!";
my $new_name = $file . '.new';
open ( my $fh_write, '>', $new_name ) or die "Could not open file '$new_name': $!";
while (my $id = <$fh>) {
chomp $id;
chomp (my $sequence = <$fh>);
if ( $ids{$id} == $num_files ) {
say $fh_write $id;
say $fh_write $sequence;
}
}
close $fh_write;
close $fh;
}
It assumes that all the .fa files are located in the directory named $file_dir, and it writes the new sequences to new files in the same directory. The new file names get the .new extension.

Need to split multiple files in a directory based on string, rename properly using powershell or fix my perl script

I have a directory full of files (text exports of Dynamics NAV objects that have been exported) in Windows. Each file contains multiple objects. I need to split each file into separate files based on lines that begin with OBJECT, and name each file appropriately.
The purpose of this is to get our Dynamics NAV system into git.
I wrote a nifty perl program to do this that works great on linux. But it hangs on the while(<>) loop in Windows (Server 2012 if that matters).
So, I need to either figure out how to do this in the PowerShell script that I wrote that generates all of the files, or fix my perl script that I'm calling from PowerShell. Does Windows perl handle filehandles differently than linux?
Here's my code:
#!/usr/bin/perl
use strict;
use warnings;
use File::Path qw(make_path remove_tree);
use POSIX qw(strftime);
my $username = getlogin || getpwuid($<);
my $datestamp = strftime("%Y%m%d-%H%M%S", localtime);
my $work_dir = "/temp/nav_export";
my $objects_dir = "$work_dir/$username/objects";
my $export_dir = "$work_dir/$username/$datestamp";
print "Objects being exported to $export_dir\n";
make_path("$export_dir/Page", "$export_dir/Codeunit", "$export_dir/MenuSuite", "$export_dir/Query", "$export_dir/Report", "$export_dir/Table", "$export_dir/XMLport");
chdir $objects_dir or die "Could not change to $objects_dir: $!";
# delete empty files
foreach(glob('*.*')) {
unlink if -f and !-s _;
}
my #files = <*>;
my $count = #files;
print "Processing $count files\n";
open (my $fh, ">-") or die "Could not open standard out: $!";
# OBJECT Codeunit 1 ApplicationManagement
while(<>)
{
if (m/^OBJECT ([A-Za-z]+) ([0-9]+) (.*)/o)
{
my $objectType = $1;
my $objectID = $2;
my $objectName = my $firstLine = $3;
$objectName =~ s/[\. \/\(\)\\]/_/g; # translate spaces, (, ), ., \ and / to underscores
$objectName =~ tr/\cM//d; # get rid of Ctrl-M
my $filename = $export_dir . "/" . $objectType . "/" . $objectType . "~" . $objectID . "~" . $objectName;
close $fh and open($fh, '>', $filename) or die "Could not open file '$filename' $!";
print $fh "OBJECT $objectType $objectID $firstLine\n";
next;
}
print $fh $_;
}
I've learned quite a bit of PowerShell in the past few days. There are some things that it really does quite well. And some (such as calling an executable with variables and command line options that have spaces) that are maddeningly difficult to figure out. To call curl, this is what I resorted to:
$curl = "C:\Program Files (x86)\cURL\bin\curl"
$arg10 = '-s'
$arg1 = '-X'
$arg11 = 'post'
$arg2 = '-H'
$arg22 = '"Accept-Encoding: gzip,deflate"'
$arg3 = '-H'
$arg33 = '"Content-Type: text/xml;charset=UTF-8"'
$arg4 = '-H'
$arg44 = '"SOAPAction:urn:microsoft-dynamics-schemas/page/permissionrange:ReadMultiple"'
$arg5 = '--ntlm'
$arg6 = '-u'
$arg66 = 'username:password'
$arg7 = '-d'
$arg77 = '"#soap_envelope.txt"'
$arg8 = "http://$servicetier.corp.company.net:7047/$database/WS/DBDOC/Page/PermissionRange"
$arg9 = "-o"
$arg99 = "c:\temp\nav_export\$env:username\raw_list.xml"
&"$curl" $arg10 $arg1 $arg11 $arg2 $arg22 $arg3 $arg33 $arg4 $arg44 $arg5 $arg6 $arg66 $arg7 $arg77 $arg8 $arg9 $arg99
I realize that part is a bit of a tangent. But I've been working really hard at trying to figure this out and not have to bother you nice folk here at stackoverflow!
I'm ambivalent about making it work in PowerShell or fixing the Perl code at this point. I just need to make it work. But I'm hoping it's just some little difference in filehandle handling between linux and Windows.
It's hard to believe that the Perl code that you show does anything on Linux either. It looks like your while loop is supposed to be reading through all of the files in the #files array, but to make it do that you have to copy the names to #ARGV.
Also note that #files will contain directories as well as files.
I suggest you change the lines starting with my #files = <*> to this. There's no reason why it shouldn't work on both Windows and Linux.
our #ARGV = grep -f, glob '*';
my $count = #ARGV;
print "Processing $count files\n";
my $fh;
while (<>) {
s/\s+\z//; # Remove trailing whitespace (including CR and LF)
my #fields = split ' ', $_, 4;
if ( #fields == 4 and $fields[0] eq 'OBJECT' ) {
my ($object_type, $object_id, $object_name) = #fields[1,2,3];
$object_name =~ tr{ ().\\/}{_}; # translate spaces, (, ), ., \ and / to underscores
my $filename = "$export_dir/$object_type/$object_type~$object_id~$object_name";
open $fh, '>', $filename or die "Could not open file '$filename': $!";
}
print $fh "$_\n" if $fh;
if (eof) {
close $fh;
$fh = undef;
}
}

Convert Yahoo Messenger Logs to Adium Logs

Is there a way to convert logs from YM for mac to Adium ?
Thanks
Cezar
#!/usr/bin/perl
use warnings;
use strict;
use File::Find;
use File::Copy;
use Getopt::Long;
my $inDir = undef;
my $outDir = undef ;
my $adiumUser = undef;
my $force = 0;
my $foundLogs = 0;
my $help = 0;
my %Protocols = ( #Map gaim protocol IDs to Adium ones
"aim" => "AIM",
"yahoo" => "Yahoo!",
"msn" => "MSN"
#Add the rest here, or tell me what they are, someone who uses other protocols
);
sub usage
{
my $msg = shift;
print "Error: $msg\n" if $msg;
print "Usage: gaim2adium.pl [--adiumUser <user> | --outDir <output dir>] [--inDir <input dir>] [--yes]\n";
print "Options: (defaults)\n\n";
print "\tinDir:\t\t\tDirectory to import logs from (~/.gaim/logs)\n";
print "\toutDir:\t\t\tDirectory to import logs to (./Logs)\n";
print "\tadiumUser:\t\tAttempt to automatically import logs to the specified Adium user\n";
print "\tyes:\t\t\tDon't prompt before overwriting existing logs\n";
print "\thelp:\t\t\tDisplay this help.\n";
print "\nOnce the logs have been imported, the contents of outDir can be dragged to your Adium log folder\n\n";
exit(1);
}
sub process_log
{
-f or return;
#gaim logs are LOG_BASE/Protocol/Account/Contact/YYYY-MM-DD-TIME.(html|txt)
if($File::Find::name =~ m!^$inDir(?:/)?(.*?)/(.*?)/(.*?)/(\d{4})-(\d{2})-(\d{2})\.(\d{4})(\d{2}).(html|txt)!)
{
my ($proto,$acct,$contact,$year,$month,$day,$hour,$seconds,$ext) = ($1,$2,$3,$4,$5,$6,$7,$8,$9);
return unless defined ($proto = $Protocols{lc $proto});
$foundLogs = 1; #Set the logs found flag
my $outFN = "$contact ($year|$month|$day).";
$outFN .= ((lc $ext) eq "html") ? "html" : "adiumLog";
mkdir("$outDir/$proto.$acct");
mkdir("$outDir/$proto.$acct/$contact");
my $file = "$outDir/$proto.$acct/$contact/$outFN";
if(-e $file && !$force)
{
# print(($adiumUser?"$adiumUser already has":"There already exists"),
# " a log from $proto.$acct to $contact on $day/$month/$year.\n");
`cat '$File::Find::name' >> '$file'`;
} else {
copy($File::Find::name,$file);
}
`touch -t $year$month$day$hour.$seconds '$file'`;
}
}
#Sort a list of log files by time
sub sort_logs
{
my #files = #_;
return sort logcmp #files;
}
sub logcmp
{
my ($t1,$t2);
$t1 = $& if $a =~ /\d{6}/;
$t2 = $& if $b =~ /\d{6}/;
return 0 unless defined($t1) && defined($t2);
return $t1 <=> $t2;
}
GetOptions( "adiumUser=s" => \$adiumUser,
"inDir=s" => \$inDir,
"outDir=s" => \$outDir,
"yes" => \$force,
"help" => \$help)
or usage();
usage() if $help;
usage("You must supply at most one of adiumUser and outDir") if defined($outDir) && defined($adiumUser);
$outDir ||= "$ENV{HOME}/Library/Application Support/Adium 2.0/Users/$adiumUser/Logs" if defined $adiumUser;
$outDir ||= "$ENV{PWD}/Logs";
$inDir ||= shift;
$inDir ||= "$ENV{HOME}/.gaim/logs";
print "NOTE: Output directory exists, existing logs will be appended to.\n" if(-d $outDir);
mkdir($outDir) unless -e $outDir;
usage("Output dir must be a directory") unless -d $outDir;
usage("Output dir must be writeable") unless -w $outDir;
usage("Input directory '$inDir' does not exist") unless -d $inDir;
usage("Input directory '$inDir' is not readable") unless -r $inDir;
#Spider the logs dir
find({wanted => \&process_log,
preprocess => \&sort_logs}, $inDir);
#Warn if we didn't find any logs
unless($foundLogs)
{
print "Warning: No recognized logs found.\n";
print "Note:\tThis script only supports logs generated by gaim 0.73 and above.\n";
print "\tYou may be able to update older gaim logs to the new format using the script from\n";
print "\thttp://sourceforge.net/forum/message.php?msg_id=2392758\n";
exit(1);
}
exit(0);

Resources