view release on metacpan or  search on metacpan

NewsClipper.pl  view on Meta::CPAN

  # Make the .NewsClipper directory if it doesn't exist already.
  mkdir "$NewsClipper::Globals::home/.NewsClipper", 0700
    unless -e "$NewsClipper::Globals::home/.NewsClipper";

  # Make the logfile directories if they don't exist already.
  {
    use File::Path;
    my $debug_log_directory = _Get_Parent_Directory($config{'debug_log_file'});
    my $run_log_directory = _Get_Parent_Directory($config{'run_log_file'});
    mkpath $debug_log_directory unless -e $debug_log_directory;
    mkpath $run_log_directory unless -e $run_log_directory;
  }

  # Initialize the HTML cache, News Clipper state, and handler factory
  require NewsClipper::Cache;
  $NewsClipper::Globals::cache = new NewsClipper::Cache;
  # To shut up the warning
  { my $dummy = $NewsClipper::Globals::cache; }

  # Be sure to do a require here to load our own version of File::Cache.
  # (Remove later when File::Cache supports persistence mechanism choice.)
  $NewsClipper::Globals::state = new File::Cache (
               { cache_key => "$NewsClipper::Globals::home/.NewsClipper/state",
                 namespace => 'NewsClipper',
                 username => '',
                 filemode => 0666,
                 auto_remove_stale => 0,
                 persistence_mechanism => 'Data::Dumper',
               } );
  # To shut up the warning
  { my $dummy = $NewsClipper::Globals::state; }

  require NewsClipper::HandlerFactory;
  $NewsClipper::Globals::handlerFactory = new NewsClipper::HandlerFactory;
  # To shut up the warning
  { my $dummy = $NewsClipper::Globals::handlerFactory; }

  ValidateSetup();
}

# ------------------------------------------------------------------------------

# This function sets up few things for the case when News Clipper is run as
# a server-side include. (We don't support running News Clipper as a CGI
# program.)

sub SetupSSI()
{
  return unless exists $ENV{SCRIPT_NAME};

  # First, we redirect STDERR to STDOUT so errors go to the browser.
  open(STDERR,">&STDOUT");
}

# ------------------------------------------------------------------------------

sub ProcessFlags
{
  # Get the command line flags. Localize @ARGV since getopt destroys it. We
  # do this before loading the configuration in order to get the -c flag.
  local @ARGV = @ARGV;
  Getopt::Long::Configure(
    qw(bundling noignore_case auto_abbrev prefix_pattern=-));
  GetOptions(\%opts, qw(i:s o:s c:s e:s a h d n r v P C H:s));

  # Treat left-over arguments as -e arguments.
  if (@ARGV)
  {
    my $joined_args = join ",",@ARGV;
    @ARGV = ('-e',$joined_args);
  }

  my %extra_opts;
  GetOptions(\%extra_opts, qw(i:s o:s c:s e:s a h d n r v P C H:s));

  if (defined $opts{e})
  {
    $opts{e} .= ",$extra_opts{e}" if defined $extra_opts{e};
  }
  else
  {
    $opts{e} = $extra_opts{e} if defined $extra_opts{e};
  }
}

# ------------------------------------------------------------------------------

# This function loads the system-wide config and the user's config. It dies
# with an error if a configuration file could not be loaded. If the user's
# configuration file can't be found or loaded in Unix, this is okay. But on
# Windows, it is an error.

sub LoadConfigFiles()
{
  my ($sysStatus,$sysConfigMessage) = LoadSysConfig();
  my ($userStatus,$userConfigMessage) = LoadUserConfig();

  # Okay situations
  return if $sysStatus eq 'okay' && $userStatus eq 'okay';
  return if $sysStatus eq 'okay' && ($userStatus eq 'open error' && !$opts{c});
  return if $sysStatus eq 'no env variable' && $userStatus eq 'okay';
  return if $sysStatus eq 'windows' && $userStatus eq 'okay';

  warn $sysConfigMessage if $sysStatus ne 'okay';
  warn "\n" if $sysStatus ne 'okay' && $userStatus ne 'okay';
  warn $userConfigMessage if $userStatus ne 'okay';
  die "\n";
}

# ------------------------------------------------------------------------------

# Loads the system-wide configuration file, storing the location of that file
# in $config{sys_config_file}. The location is specified by the NEWSCLIPPER
# environment variable.

sub LoadSysConfig()
{
  my $warnings;

  $config{sys_config_file} = 'Not specified';