view release on metacpan or  search on metacpan

nnsync.PL  view on Meta::CPAN

#!/app/unido-i06/magic/perl
#                              -*- Mode: Perl -*- 
use Config;
use File::Basename qw(&basename &dirname);

# List explicitly here the variables you want Configure to
# generate.  Metaconfig only looks for shell variables, so you
# have to mention them as if they were shell variables, not
# %Config entries.  Thus you write
#  $startperl
# to ensure Configure will look for $Config{startperl}.

# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"

open OUT,">$file" or die "Can't create $file: $!";

print "Extracting $file (with variable substitutions)\n";

# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.

print OUT <<"!GROK!THIS!";
$Config{'startperl'} -w
!GROK!THIS!
# In the following, perl variables are not expanded during extraction.

print OUT <<'!NO!SUBS!';
#                              -*- Mode: Perl -*- 
# mm -- 
# ITIID           : $ITI$ $Header $__Header$
# Author          : Ulrich Pfeifer
# Created On      : Sat Nov  2 17:28:28 1996
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Mon Mar 24 10:59:58 1997
# Language        : CPerl
# Update Count    : 84
# Status          : Unknown, Use with caution!
# 
# (C) Copyright 1996, Universität Dortmund, all rights reserved.
# 
# 
eval 'exec perl -w -S $0 "$@"'
    if 0;

use Getopt::Long;
use IO::File;
use strict;
use vars qw(%OPT);
use NNML::Config qw($Config);

my $home = $ENV{'HOME'} || $ENV{'LOGDIR'} ||
    (getpwuid($<))[7] || die "You're homeless!\n";

my $conf = $Config->base . "/NNML.conf";
my $date = $Config->base . "/NNML.date";

GetOptions(\%OPT,
           'nono!'
           ) or die "Usage: $0 ...\n";

my $cf = new IO::File "<$conf";
die "Could not read '$conf': $!\n" unless $cf;

$/ = '';                        # read paragraph mode

my %date = read_dates($date);
my %new_date;                   # we append anyway
my %key;                        # pid -> from;to
my %start;                      # pid -> start time

$SIG{CHLD} = sub {
  my $pid    = wait;
  my $status = $? >> 8;
  print "Child $pid terminated with status $status\n";
  if ($key{$pid}) {
    $new_date{$key{$pid}} = $start{$pid} unless $status;
    print "Key was $key{$pid}, start time was $start{$pid}\n";
    delete $key{$pid};
  } else {
    print "No key for this child!?\n";
  }
};

my $job;
while (defined ($job = <$cf>)) {
  my %job;
  my $line;
  for $line (split /\n/, $job) {
    next if $line =~ /^\#/;
    next if $line =~ /^\s*$/;
    my ($cmd,@fld) = split ' ', $line;
    for (@fld) {
      $_ = '' if $_ eq '*';
    }
    if      ($cmd eq 'from') {
      @job{qw(fhost fuser fpass fport only)} = @fld;

      if ($job{only}) {
        if ($job{only} =~ s/^!//) {
          $job{ignore} = $job{only};
          delete $job{only};
        }
      } else {
        delete $job{only};
      }
    } elsif ($cmd eq 'to') {
      @job{qw(thost tuser tpass tport)} = @fld;
    } elsif ($cmd eq '*') {
      push @{$job{group}}, @fld;
    }
  }
  run_job(%job) if scalar %job;