# -*- mode: Perl; -*-
package NewsClipper::Globals;
# This package contains a set of globals used by all News Clipper modules.
use strict;
# For exporting of functions
use Exporter;
use vars qw( @ISA @EXPORT $VERSION );
@ISA = qw( Exporter );
@EXPORT = qw( DEBUG reformat dprint lprint dequote %errors %config %opts);
$VERSION = 0.30;
# ------------------------------------------------------------------------------
# We'll use a global DEBUG constant, which is set by the -d flag on the
# command line. (Be sure to "require" this module after doing getopt in main.
# Debug mode doesn't put a time limit on the script, outputs some
# <!--DEBUG:...--> commentary, and doesn't write to the output file (instead
# it dumps to screen).
use constant DEBUG => $main::opts{d} || 0;
# ------------------------------------------------------------------------------
# We will alias this variable to the one in main so that it will be easily
# accessible by all modules. We don't simply put this variable here because it
# is used in main before this module is loaded.
*config = \%main::config;
# ------------------------------------------------------------------------------
# We will alias this variable to the one in main so that it will be easily
# accessible by all modules. We don't simply put this variable here because it
# is used in main before this module is loaded.
*opts = \%main::opts;
# ------------------------------------------------------------------------------
# This variable will hold error messages from various parts of the system.
# These messages will be stored according to their location, and then printed
# as News Clipper commands execute. The contents are cleared at the end of
# each sequence of News Clipper commands.
my %errors;
# ------------------------------------------------------------------------------
# The user's home directory (Initialized in main::SetupConfig)
my $home;
# The cache. There is only one. (Initialized in main::SetupConfig)
my $cache;
# The News Clipper state. There is only one. (Initialized in main::SetupConfig)
my $state;
# The handler factory. There is only one. (Initialized in main::SetupConfig)
my $handlerFactory;
# ------------------------------------------------------------------------------
use Text::Wrap;
# Reformats the input to 80 columns, or the number specified by the first
# argument. Retains any empty lines at the end.
sub reformat(@)
{
my $columns;
if ($#_ > 0 && $_[0] =~ /^\d+$/)
{
$columns = shift;
}
else
{
$columns = 80;
}
my $text = join '\n',@_;
my ($ending_newlines) = $text =~ /(\n*)$/s;
$ending_newlines = '' unless defined $ending_newlines;
$text =~ s/\n*$//;
# Change all the newlines to spaces in preparation of reformatting.
$text =~ s/\n/ /g;
$Text::Wrap::columns = $columns;
my $formatted = wrap('','',$text);
# Tack a newline on the end if the original had one.
$formatted .= $ending_newlines;
return $formatted;
}
# ------------------------------------------------------------------------------
use Log::Agent;
use Log::Agent::Driver::File;
use Log::Agent::Rotate;
my $_driver;
# Initialize the log files if they haven't been initialized already.
sub _Initialize_Log_Files
{
return if defined $_driver;
my $rotate = Log::Agent::Rotate->make(
-backlog => $main::config{'max_number_of_log_files'},
-max_size => $main::config{'max_log_file_size'},
-is_alone => 1,
);
my ($error_channel_setup,$debug_channel_setup);
# Handle non-rotating special output files
if ($main::config{'run_log_file'} =~ /^(STDERR|STDOUT)$/)
{
$error_channel_setup = ">&$main::config{'run_log_file'}";
}
else
{
$error_channel_setup = [$main::config{'run_log_file'}, $rotate];
}
if ($main::config{'debug_log_file'} =~ /^(STDERR|STDOUT)$/)
{
$debug_channel_setup = ">&$main::config{'debug_log_file'}";
}
else
{
$debug_channel_setup = [$main::config{'debug_log_file'}, $rotate];
}
$_driver = Log::Agent::Driver::File->make(
-channels => {
'error' => $error_channel_setup,
'debug' => $debug_channel_setup,
},
-stampfmt => 'none',
-magic_open => 1,
);
logconfig(-driver => $_driver, -debug => 10);
}
# ------------------------------------------------------------------------------
# Prints debug messages in the form "<!--DEBUG: ... -->" if the DEBUG constant
# is true.
sub dprint(@)
{
return 1 unless DEBUG;
my $message = join '',@_;
_Initialize_Log_Files();
my @lines = split /\n/, $message;
foreach my $line (@lines)
{
logdbg(1,$line);
}
return 1;
}
# ------------------------------------------------------------------------------
# Logs messages to the logfile.
sub lprint(@)
{
my $message = join '',@_;
_Initialize_Log_Files();
my @lines = split /\n/, $message;
foreach my $line (@lines)
{
logerr($line);
}
return 1;
}
# ------------------------------------------------------------------------------
# Allows indented here documents. Modified from the Perl Cookbook. The first
# argument can be a prefix string to start each line with.
sub dequote($;$)
{
my $prefix;
$prefix = shift if $#_ == 1;
local $_ = shift;
my ($white, $leader);
if (/^\s*(?:([^\w\s<>!@#\$\%^&*()]+)(\s*).*\n)(?:\s*\1\2?.*\n)+$/)
{
($white, $leader) = ($2, quotemeta($1));
}
else
{
($white, $leader) = (/^(\s*)/,'');
}
s/^\n/$white\n/gm;
s/^\s*?$leader(?:$white)//gm;
# Put the prefix on if one was specified
$_ =~ s/^/$prefix/gm if $prefix;
return $_;
}
# ------------------------------------------------------------------------------
1;