#!/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 () { 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 =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 #