#!/opt/bin/perl
#
#########################################################################
#                                                                       #
#   Program for automatic aging of problem reports in given folders     #
#                                                                       #
#########################################################################
#                                                                       #
#   Version 1.0     -   Written 13.05.96 by Steffen Beyer               #
#                                                                       #
#########################################################################
#                                                                       #
#   Copyright (C) 1995 by software design & management GmbH & Co. KG    #
#                                                                       #
#########################################################################

use Date::DateCalc qw(:all);

use lib
qw(
    /u/sb/sw/pkg/perl/lib/perl/5.12.0/amd64-freebsd
    /u/sb/sw/pkg/perl/lib/perl/5.12.0
    /u/sb/sw/pkg/perl/lib/perl/site_perl/5.12.0/amd64-freebsd
    /u/sb/sw/pkg/perl/lib/perl/site_perl/5.12.0
);

require "parse_date.pl";

unshift(@INC, '/opt/lib/problem');

require "config.pl";

# Configure here the permitted delay of completion (in days) for each priority:

$delay[0] = 10*7; # 10 weeks = approx. 2 months
$delay[1] =  8*7; #  8 weeks = 2 months
$delay[2] =    7; #  1 week
$delay[3] =    1; #  1 day
$delay[4] =    0; #  immediately
$delay[5] =   -1; #  yesterday and before...

# Configure here the name(s) of your problem report folder(s):
# (MUST be an ABSOLUTE path!!!)

push(@folder, '/u/preport/preport');
push(@folder, '/u/preport/zurueck');

&configure();

$path =~ s!/$!!;
foreach $file (@files)
{
    $file =~ s!^/!!;
    push(@folder, "$path/$file");
}

# Default settings:

$version = 'version 1.0';

$self = $0;
$self =~ s!^.*/!!;

# Check if running under root:

unless (($< == 0) && ($> == 0))
{
    die "$self: not running under proper UID (root)!\n";
}

# Parse today's date:

($year,$month,$day) = parse_date(`/bin/date`);

unless (check_date($year,$month,$day))
{
    die "$self: unable to parse today's date!\n";
}

# Follow symbolic links:

foreach $filename (@folder)
{
    while (-l $filename)
    {
        $symlink = readlink($filename);
        if ($symlink =~ m!^/!)
        {
            $filename = $symlink;
        }
        else
        {
            $filename =~ s![^/]+$!$symlink!;
        }
    }
}

# Loop through list of folders:

FOLDER:
for ( $i = 0; $i <= $#folder; $i++ )
{
    # Loop through folder:

    $filename = $folder[$i];
    unless (open(OLD_FOLDER, "<$filename"))
    {
        warn "$self: unable to read '$filename': $!\n";
        next FOLDER;
    }
    else
    {
        unless (rename($filename,"$filename.old"))
        {
            warn "$self: unable to rename '$filename' to '$filename.old': $!\n";
            next FOLDER;
        }
        unless (open(NEW_FOLDER, ">$filename"))
        {
            warn "$self: unable to write '$filename': $!\n";
            &abort;
            next FOLDER;
        }
        $flag = 0;
        LINE:
        while ($line = <OLD_FOLDER>)
        {
            chop($line);
            if ($line =~ /^From \S/)
            {
                if ($flag)
                {
                    unless (&process_preport)
                    {
                        warn "$self: unable to process preport in '$filename.$self'!\n";
                        &abort;
                        next FOLDER;
                    }
                }
                unless (open(PREPORT, ">$filename.$self"))
                {
                    warn "$self: unable to write '$filename.$self': $!\n";
                    &abort;
                    next FOLDER;
                }
                $flag = 1;
                $prio = 0; # initialize priority to minimum priority
                ($yy,$mm,$dd) = parse_date($line); # parse submission date
            }
            if ($flag)
            {
                print PREPORT "$line\n";
                if ($line =~ /^\s*\[\s*\S+\s*\]\s+gering/)
                {
                    if ($prio < 1) { $prio = 1; }
                }
                elsif ($line =~ /^\s*\[\s*\S+\s*\]\s+normal/)
                {
                    if ($prio < 2) { $prio = 2; }
                }
                elsif ($line =~ /^\s*\[\s*\S+\s*\]\s+dringend/)
                {
                    if ($prio < 3) { $prio = 3; }
                }
                elsif ($line =~ /^\s*\[\s*\S+\s*\]\s+extrem wichtig/)
                {
                    if ($prio < 4) { $prio = 4; }
                }
                else { }
            }
        }
        if ($flag)
        {
            unless (&process_preport)
            {
                warn "$self: unable to process preport in '$filename.$self'!\n";
                &abort;
                next FOLDER;
            }
        }
        close(OLD_FOLDER);
        close(NEW_FOLDER);
    }
}

exit 0;

sub process_preport
{
    my($line,$diff,$i);

    $flag = 0;
    close(PREPORT);
    if (check_date($yy,$mm,$dd))
    {
        $diff = dates_difference($yy,$mm,$dd,$year,$month,$day);
        for ( $i = $#delay; $i > 0; $i-- )
        {
            if ($diff >= ($delay[$prio]-$delay[$i]))
            {
                $prio = $i;
                last;
            }
        }
    }
    unless (open(PREPORT, "<$filename.$self"))
    {
        warn "$self: unable to read '$filename.$self': $!\n";
        return(0);
    }
    while ($line = <PREPORT>)
    {
        chop($line);
        if    ($line =~ /^Subject:\s+\d\s+(\d\d\d\d)\s+(.+)$/)
        {
            $line = "Subject: $prio $1 $2";
        }
        elsif ($line =~ /^Subject:\s+\d\s+(.+)$/)
        {
            $line = "Subject: $prio $1";
        }
        elsif ($line =~ /^Subject:\s+(.+)$/)
        {
            $line = "Subject: $prio $1";
        }
        else { }
        print NEW_FOLDER "$line\n";
    }
    close(PREPORT);
    unlink("$filename.$self");
    return(1);
}

sub abort
{
    close(OLD_FOLDER);
    close(NEW_FOLDER);
    unless (rename("$filename.old",$filename))
    {
        warn "$self: unable to rename '$filename.old' to '$filename': $!\n";
    }
}

__END__