view release on metacpan or  search on metacpan

overview.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'} 
!GROK!THIS!
# In the following, perl variables are not expanded during extraction.

print OUT <<'!NO!SUBS!';
#                              -*- Mode: Perl -*- 
# nnml.pl -- 
# ITIID           : $ITI$ $Header $__Header$
# Author          : Ulrich Pfeifer
# Created On      : Fri Mar 10 10:34:08 1995
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Mon Mar 24 11:00:47 1997
# Language        : Perl
# Update Count    : 93
# Status          : Unknown, Use with caution!
# 
# (C) Copyright 1996, Universität Dortmund, all rights reserved.
# 
eval 'exec perl  -S $0 "$@"'
    if 0;

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

use Getopt::Long;

&GetOptions(\%OPT,
            'base=s',
            'dir=s',
            'force',
            'verbose',
            'debug',
           ) || die "Usage: $0 ... \n";

$base = $OPT{base} || "$home/Mail";
$dir  = $OPT{dir}  || $base;
$nov  = '.overview';
$active      = "$base/active";
$active_time = &mtime($active);
$OPT{verbose} = 1 if $OPT{debug};

unless ($base =~ m:^/:) {
  $base = getcwd . '/' . $base;
}

&read_active($active);
&find($dir);
&write_active($active);

exit 0;

sub read_active {
    my($active) = @_;
    my($group,$data);

    print STDERR "read_active\n" if $OPT{debug};
    return unless -e $active;
    open(ACTIVE, "<$active") || die "Could not open $active: $!\n";
    while (<ACTIVE>) {
        ($group,$data) = split(/\s+/,$_,2);
        $ACTV{$group} = $data;
    }
    close ACTIVE;
}

sub write_active {
    my($active) = @_;

    print STDERR "write_active\n" if $OPT{debug};
    rename $active, "$active~";
    open(ACTIVE, ">$active") || die "Could not open $active: $!\n";
    for (sort keys %ACTV) {
        print ACTIVE "$_ $ACTV{$_}";
    }
    close ACTIVE;
}

sub mtime {
    my($file) = @_;

    if ( -e $file ) {
        (stat($file))[9];