#!/usr/bin/env perl
#	NB that the -i flag edits in place; -w yields warnings
#
# Given the source file which also hax a .ps or .txt form, 
#   remove it from the in_basket and put it in the propoer place 
#   in the file_cabinet.
# Documents must be named in the form 01234_rZ.ps
# If the -force flag is used, don't check for a *.ps form
#

# The Document Tree is relative to the In Basket
$DocBase = "../file_cabinet/" ;
$Itar    = "itar/";
$Flagitar = 0;

if ( $0 =~ /.*itar$/ ) {
    $DocBase = $DocBase . $Itar ;
    $Flagitar++;
    }
#print $DocBase;
#exit 0;

#############################################
# End of program-specific stuff
#############################################

use File::Copy ;
$\ = "";             # only to keep error messages in check

# This matches a drawing number
$BASENAME = "([0-9]{5}(_[0-9]{2}|_[0-9]{4}|_[0-9]{6}|_[0-9]{8}|_[0-9]{10})?_?(S[0-9])?_r([0-9]{2}|[-A-Z]{1})[mjq]{0,3})";
$SUFFIX = "(cad|doc|docx|odt|dsn|dwg|dxf|eprt|easm|eps|fm|itar|md|pdf|ppt|pptx|prn|ps|sch|txt|xls|xlsx|xlsm|vamp|DSN|zip|gz|tar.gz|tgz|gv|SLDDRW|SLDPRT)" ;

# First open the directory to see what we have
# We use the first to sweep once, the second to revisit!
opendir(HERE,".") || die "Cannot open current directory for read" ;

# Get a single file, generate PDF equivalent, and
#   put it away, deleting the matching set from the directory
@dirlist = grep(!/^\./, readdir(HERE)) ;

if ( defined($ARGV[0]) && $ARGV[0] =~ /^-[hH]/ ) {
    print "usage: dbputaway [-f[orce]] [-h[elp]]\n";
    print "  puts files in current directory into e-file-cabinet\n";
    print "  generating PDF formatted files from supplied *.ps files\n";
    print "  with -f flag forcing no checks or PDF generation\n";
    print "  and -h flag giving this help message\n";
    print "\nOnly the files with the following suffixes are considered valid:\n";
    print "  $SUFFIX\n";
    print "\nIf invoked with the name ending in \"itar\" \n";
    print "  the files will be put into e-file-cabinet/itar \n";
    print "  which presumably has been set up with restricted access.\n";
    print "As a second check, a file with a \"q\" final character in\n";
    print "  the rev block can only be filed with the -itar version.\n";
    exit(0);
}

$force = 0;
foreach $nextone (@dirlist) {
    if ( -r $nextone ) {   # the file might have been put away previously
	if ( $nextone =~ /.*q\..*$/ ) {  # check for itar document
	    die "Looks like an ITAR document" if (!$Flagitar);
	}
	if ( defined($ARGV[0]) && $ARGV[0]=~/^-[fF]/ ) {
	    $force++;
	    (&valid($nextone)) || (&putaway) ;
	} else {
	    (&valid($nextone)) || (&genpdf) || (&putaway) ;
	}
    }
}
exit 0;

# This subroutine uses distill to generate a PDF file if it does
#   not already exist; returns 1 on success, 0 on failure
sub genpdf {
# The simple, skip-the-convert, cases
#   but NB that readdir walks the namespace
# We are allowing that multiple sheets may have only one PDF|TXT file
# A -force argument also causes us to skip this step

    rewinddir(HERE);
    @psfile = ( grep(/($base|$baseless)\.(ps|eps|prn)/, readdir(HERE)) ) ;
    rewinddir(HERE);
    @pdffile = ( grep(/($base|$baseless)\.(pdf|txt)/, readdir(HERE)) ) ;
    rewinddir(HERE);
    @easmfile = ( grep(/($base|$baseless)\.(easm|eprt)/, readdir(HERE)) ) ;

    if ( @pdffile || @easmfile ) { # PDF or TXT exists
	return 0;
    }

    my $retval = 1;   # primed for failure

    if ( @psfile ) {
	system("distill -quiet $psfile[0]");
# Unfortunately, distill doesn't indicate success in its return value
#   so we aren't even sure if the log file exists
	if ( -r "$base.log" ) {
	    open(DLOG,"$base.log") || die "Open $base.log for read failed";
	    while (<DLOG>) {
		if ( /\[ LastPage \]/ ) {
		    $retval = 0;   # successful PDF generation
		}
	    }
	    close(DLOG);
	    unlink("$base.log") || die "Unlink of $base.log failed";
	}
    } else {
	print "No PDF or Postscript version of $base exists!\n";
    }
    return $retval;
}

# We move all files with the same $base name to the appropriate place.
# File name sanity checks were done in &genpdf.
sub putaway {
    local($dir) = $base ;
    $dir =~ s%^([0-9]).*%$DocBase$1/% ;
# set up the file_cabinet directory
    if ( ! -d $dir ) {
	mkdir($dir,0775) || die "Could not make directory $dir" ;
    }
    if ( ! -w $dir ) {
	die "Cannot write to directory $dir" ;
    }
    local($subdir) = $base;
    $subdir =~ s%^([0-9]{5}).*%$dir$1/% ;
    if ( ! -d $subdir ) {
	mkdir($subdir,0775) || die "Could not make directory $subdir" ;
    }
    if ( ! -w $subdir ) {
	die "Cannot write to directory $subdir" ;
    }
# Check to see that this is really a new revision
    if ( !$force && -r "$subdir/$base.pdf" || -r "$subdir/$base.txt " ) {
	print "This revision of $base already exists in $subdir\n";
	return 1;
    }
# Gather all filenames with this base and put them away
# If a force is on and file already exists, clear read-only before copy
    rewinddir(HERE);
    $baseless =~ s/(.*)_(r[-A-Z0-9]+[rj]{0,2})/$1/ ;
    my $start = $1; my $rev = $2;

    my @filelist = grep(/^$start(S[1-9])?_$rev/, readdir(HERE)) ;

    foreach $item (@filelist) {
	if ( $force && -r "$subdir/$item" ) {
	    chmod(0664,"$subdir/$item") ||
		die "Could not clear write-protect $subdir/$item";
	    print "Clearing old $subdir/$item\n";
	    }
	copy("$item","$subdir/$item") || 
		die "Could not copy $item to $subdir";
	chmod(0444,"$subdir/$item") || 
		die "Could not set write-protect $subdir/$item";
	print "Filed $item\n";
	if ( -r $item ) {     # -w flag does not test GROUP permissions
	    unlink("$item") || die "Could not remove $item" ;
	} else {
	    print "You do not have permission to delete $item\n";
#	    return 0;
	}
    }
}

# A filename comes as the sole argument
# NB $base and $ext are set as global variables
sub valid {
    ($base = $_[0]) =~ s/\.[A-z]+$//;    # Get the primary number
    ($baseless = $base) =~ s/S[1-9]+_r/_r/; # Get rid of the sheet numbers
    ($ext  = $_[0]) =~ s/^.+\.//;        # Get the suffix
# Two sanity checks for valid names
    if ( $ext !~ "(^$SUFFIX\$)" ) {
	print "Document type not recognized: .$ext\n";
	exit 1;   # This needs to "exit" or Putaway will file it when
	          #   it gets to the PDF version and stuffs /all/ similar
	          #   files with the same basename.
    }
    if ( $_[0] !~ "^$BASENAME\.$SUFFIX\$" ) {
	print "Invalid document number: $_[0]\n";
	return 1;
    }
    return 0;
}

########################################################################
# Pod follows
# NB the CSS addition makes possible the desired indent with
#   =over/=item...=item/=back construct when used in an HTML context
########################################################################

=for html 
<style type="text/css">
dl {margin-left: 2cm;}
</style>

=head2 NAME

dbputaway -- Puts documents into a data base e-file directory tree

=head2 USAGE

    dbputaway [-f] [-h]

=head2 FLAGS

    -f[orce]    run with no error checking on e-file
    -h[elp]     produces this help messagn.

=head2 DESCRIPTION

This program is limited to use with standard Configuration Data Base
documents and directory structures.

All files in the current directory are acted upon.  The syntax of
the standard numbering system is partially checked, and only valid
suffixes are allowed (see the -help message for the current, hardwired
list). For each basename -- without suffix -- there must exist a file 
with either a "pdf" or "txt" suffix.  
(If a Postscript version exists, the program will try to 
generate a PDF from that.) The -f flag overrides this check.

There must exist, in the paraent directory to the current one, a link
named "file_cabinet" which point to the top of the e-file tree.  The
program determines, based upon the file name, to which sub-directory each
file should be moved.  If the sub-directory does not exist, it is created.
Pre-existing files are not overwritten; again, the -f flag will override.

After the files are moved, they are set to read-only.  No files remain
in the current directory unless there has been a execution failure.

If invoked with a command name ending in "itar" the files will be 
deposited in a parallel univers under "file_cabinet/itar" which can
be set to have restricted access.
=head2 BUGS

None reported yet.

=head2 SEE ALSO

=head4 High Level programs

dbnormal

=head4 Low Level programs

=head2 AUTHOR

Bob Goeke

=head2 RCS Information

$Id: dbputaway,v 1.15 2022/05/06 23:21:37 goeke Exp goeke $

=cut

#####################################################################
# History
#####################################################################
# $Log: dbputaway,v $
# Revision 1.15  2022/05/06 23:21:37  goeke
# $BASENAME and $SIFFIX updates/explansions
#
# Revision 1.14  2015/07/14 19:28:43  goeke
# Added .tgz type to accepted documents
#
# Revision 1.13  2014/07/03 13:21:52  goeke
# Added .gz and .tar.gz to valid file suffix list
#
# Revision 1.12  2014/04/15 17:38:10  goeke
# Added check for a "q" in the rev block -> ITAR use only
#
# Revision 1.11  2014/04/15 13:01:52  goeke
# Added "odt" extension as valid
#
# Revision 1.10  2014/04/10 18:19:26  goeke
# Added itar-parallel file system
#
# Revision 1.9  2013/07/20 19:59:55  goeke
# Added pod
#
# Revision 1.8  2006/02/15 21:13:48  goeke
# Update to handle revs in form "-rj"
#
# Revision 1.7  2005/12/12 18:41:53  goeke
# Fixed bug in &valid logic; see notes there
#
# Revision 1.6  2005/09/15 18:46:26  goeke
# Added *easm as a valid suffix without matching PDF file
#
# Revision 1.5  2004/12/02 15:25:49  goeke
# Update valid suffix entries for file types
#
# Revision 1.4  2002/07/29  15:34:37  goeke
# Allow multiple sheet drawings to have a common PDF file
#
# Revision 1.3  2002/07/29  12:39:17  goeke
# Add some more terminating descriptors in $SUFFIX and
# improve the force behaviour.
#
# Revision 1.2  2002/01/02  16:32:46  goeke
# Added help message
# Fixed -f flag to force filing of *doc files if *pdf exist
#
# Revision 1.1  2001/05/11 20:16:02  goeke
# Initial revision
#