Document maintenance script

   1: #!/usr/bin/perl
   2: use strict;
   3: 
   4: sub making_of_list {
   5: 
   6: my $ftp="c:/ftproot";
   7: opendir (FTP, $ftp) || die $!;
   8: my @file = readdir FTP;
   9: close FTP;
  10: my $a=0;
  11: foreach (@file) {
  12: 	
  13: 	open (FILES, "+>>c:/docu/ftproot.txt") || die $!;
  14: 	if ("$file[$a]" =~ /txt/i) {
  15: 		print FILES $file[$a],"\n";
  16: 	} elsif ("$file[$a]" =~ /doc/i) {
  17: 		print FILES $file[$a],"\n";	
  18: 	} elsif ("$file[$a]" =~ /mpd/i) {
  19: 		print FILES $file[$a],"\n";
  20: 	} elsif ("$file[$a]" =~ /mta/i) {
  21: 		print FILES $file[$a],"\n";
  22: 	}else {
  23: 	}
  24: $a++;
  25: close FILES;
  26: }
  27: 
  28: ############################################################
  29: 
  30: sub copy_from_root {
  31: 
  32: use File::Copy;
  33: my $ftplist = "c:/docu/ftproot.txt";
  34: open (FILE, $ftplist) || die $!;
  35: my @disk = <FILE>;
  36: chomp @disk = <FILE>;
  37: $b = 0;
  38: foreach (@disk) {
  39: 	my $report = $disk[$b];
  40: 	print $report,"\n";
  41: 	if ("$report" =~ /^afinv/i) {
  42: 		my $reports = $report;
  43: 		$reports =~ s/.mta/.mpd/ig;
  44: 		my $truth="c:/scripts/attempt/$reports";
  45: 		my $inv="c:/invoice/$reports";
  46: 		my $apollo="c:/reports/$reports";
  47: 		my $daym=(localtime(time()))[3];
  48: 		my $afis3="c:/afis3too/$daym/$reports";
  49: 		my $source = "c:/ftproot/$report";
  50: 		foreach my $dest ($truth, $afis3, $apollo, $inv) {
  51: 			copy ($source, $dest);
  52: 		}
  53: 		unlink $source;
  54: 	} elsif ("$report" =~ /^csinv/i) {
  55: 		my $reports = $report;
  56: 		$reports =~ s/.mta/.mpd/ig;
  57: 		my $truth="c:/scripts/attempt/$reports";
  58: 		my $inv="c:/invoice/$reports";
  59: 		my $apollo="c:/reports/$reports";
  60: 		my $daym=(localtime(time()))[3];
  61: 		my $afis3="c:/afis3too/$daym/$reports";
  62: 		my $source = "c:/ftproot/$report";
  63: 		foreach my $dest ($truth, $afis3, $apollo, $inv) {
  64: 			copy ($source, $dest);
  65: 		}
  66: 		unlink $source;
  67: 	} elsif ("$report" =~ /^sfinv/i) {		
  68: 		my $reports = $report;
  69: 		$reports =~ s/.mta/.mpd/ig;
  70: 		my $truth="c:/scripts/attempt/$reports";
  71: 		my $inv="c:/invoice/$reports";
  72: 		my $apollo="c:/reports/$reports";
  73: 		my $daym=(localtime(time()))[3];
  74: 		my $afis3="c:/afis3too/$daym/$reports";
  75: 		my $source = "c:/ftproot/$report";
  76: 		foreach my $dest ($truth, $afis3, $apollo, $inv) {
  77: 			copy ($source, $dest);
  78: 		}
  79: 		unlink $source;
  80: 	} elsif ("$report" =~ /doc/i) {
  81: 		my $reports = $report;
  82: 		$reports =~ s/doc/txt/ig;
  83: 		my $truth="c:/scripts/attempt/$reports";
  84: 		my $apollo="c:/reports/$reports";
  85: 		my $daym=(localtime(time()))[3];
  86: 		my $afis3="c:/afis3too/$daym/$reports";
  87: 		my $source = "c:/ftproot/$report";
  88: 		foreach my $dest ($truth, $afis3, $apollo) {
  89: 			copy ($source, $dest);
  90: 		}
  91: 		unlink $source;
  92: 	} elsif ("$report" =~ /mta/i) {
  93: 		my $reports = $report;
  94: 		$reports =~ s/.mta/.mpd/ig;
  95: 		my $truth="c:/scripts/attempt/$reports";
  96: 		my $apollo="c:/reports/$reports";
  97: 		my $daym=(localtime(time()))[3];
  98: 		my $afis3="c:/afis3too/$daym/$reports";
  99: 		my $source = "c:/ftproot/$report";
 100: 		foreach my $dest ($truth, $afis3, $apollo) {
 101: 			copy ($source, $dest);
 102: 		}
 103: 		unlink $source;		
 104: 	} else {
 105: 		my $reports = $report;
 106: 		my $truth="c:/scripts/attempt/$reports";
 107: 		my $listing="c:/scripts/fink.txt";
 108: 		my $apollo="c:/reports/$reports";
 109: 		my $daym=(localtime(time()))[3];
 110: 		my $afis3="c:/afis3too/$daym/$reports";
 111: 		my $source = "c:/ftproot/$report";
 112: 		foreach my $dest ($truth, $afis3, $apollo) {
 113: 			copy ($source, $dest);
 114: 		}
 115: 		unlink $source;
 116: 	}
 117: 	my $listing="c:/scripts/fink.txt";
 118: 	open (LST,"+>>$listing")or die "$!";
 119: 	my $paper = sprintf("%.6s", $report);
 120: 	my $bbat=".bat";
 121: 	my $pap=join("",$paper,$bbat);
 122: 	$pap =~ tr/a-z/A-Z/;
 123: 	print LST $pap,"\n";
 124: 	close LST;
 125: 	$b++;
 126: }
 127: }
 128: }
 129: ############################################################
 130: 
 131: sub make_list_for_batches {
 132: 
 133: my $lst = "c:/scripts/fink.txt";
 134: 
 135: open (LST, $lst) || die $!;
 136: my (@array, %hash);
 137: foreach (<LST>) {
 138: 	push (@array, $_) unless (defined($hash{$_}));
 139: 	$hash{$_} = 1;
 140: };
 141: close (LST);
 142: open (LST, ">$lst") || die $!;
 143: print LST join("", @array);
 144: close (LST);
 145: }
 146: 
 147: ############################################################
 148: 
 149: sub this_gets_a_listing_of_the_batch_files {
 150: 
 151: my $bats="c:/reports";
 152: opendir (BATS, $bats) || die $!;
 153: my @bat = readdir BATS;
 154: close BATS;
 155: my $r=0;
 156: foreach (@bat) {
 157: 	if ("$bat[$r]" =~ /bat/i) {
 158: 		open (STAB, "+>>c:/scripts/bats.txt") || die $!;
 159: 		print STAB $bat[$r],"\n";
 160: 	}
 161: 	$r++;
 162: }
 163: close STAB;
 164: }
 165: 
 166: ############################################################
 167: 
 168: sub wow {
 169: 
 170: my $batch="c:/scripts/bats.txt";
 171: my $fink = "c:/scripts/fink.txt";
 172: my $wow="c:/scripts/wow.txt";
 173: open (BAT, "+$batch") or die $!;
 174: open (LST, "+$fink") or die $!;
 175: my @batch = <BAT>;
 176: my @lst = <LST>;
 177: my $c = 0;
 178: foreach (@lst){
 179: 	my $sub=$lst[$c];
 180: 	my $d=0;
 181: 	foreach (@batch){
 182: 		my $sub2 = $batch[$d];
 183: 		if ("$sub2" =~ /$sub/ig){
 184: 			open (WOW, "+>>$wow") or die $!;
 185: 			print WOW $batch[$d];
 186: 			print "Working...\n";
 187: 		}$d++;
 188: 	}$c++;
 189: }
 190: close BAT;
 191: close LST;
 192: close WOW;
 193: }
 194: 
 195: ############################################################
 196: 
 197: sub run_the_batches {
 198: 
 199: my $copy="c:/scripts/wow.txt";
 200: open (COPY, "+$copy") || die $!;
 201: my @co = <COPY>;
 202: chomp @co = <COPY>;
 203: my $s=0;
 204: my $output = "c:/reports/$co[$s]";
 205: foreach (@co) {
 206: 	system ($output);	
 207: 	$s++;
 208: }
 209: 
 210: }
 211: 
 212: ############################################################
 213: 
 214: sub delete {
 215: 
 216: my $fink = "c:/scripts/fink.txt";
 217: my $bat = "c:/scripts/bats.txt";
 218: my $wowo = "c:/scripts/wow.txt";
 219: my $ftpr = "c:/docu/ftproot.txt";
 220: 
 221: open (FINK, "+>$fink") || die "$!";
 222: open (BAT, "+>$bat") || die "$!";
 223: open (WOW, "+>$wowo") || die "$!";
 224: open (FTP, "+>$ftpr") || die "$!";
 225: 
 226: unlink <FINK>;
 227: unlink <BAT>;
 228: unlink <WOW>;
 229: unlink <FTP>;
 230: 
 231: }
 232: 
 233: #
 234: #
 235: #
 236: #
 237: #
 238: ############################################################
 239: 
 240: ############################################################
 241: 
 242: 
 243: print "\n\n\n";
 244: print "         Robco Inc. Presents :   \n\n\n";
 245: print "     The NEW, AMAZING, INCREDIBLE ....\n\n\n";
 246: print "      Robco Document Rotisserie!!!!!\n\n\n";
 247: print "Just RENDER it, THEN don't REMEMBER it!!!!!\n\n";
 248: print "         It's just that easy.\n\n\n\n\n";
 249: 
 250: while (1) {
 251: 
 252: 	my $clock = localtime;
 253: 	print $clock,"\n";
 254: 	print "sleeping ....  ZzZzZzZzZz......\n";
 255: 	sleep (10);
 256: 	print "OK! OK!  ....  I'm awake!  ....  I'm awake\n";
 257: 	&copy_from_root;
 258: 	&make_list_for_batches;
 259: 	&this_gets_a_listing_of_the_batch_files;
 260: 	&wow;
 261: 	&run_the_batches;
 262: 	&delete;
 263: 	&making_of_list;	
 264: }
 265: 
 266: # Edited by Ovid 2001/06/15
 267: # Shortened title from:  a program to go find documents in a file then copy
 268: # them to seperate folders, delete them from the original folder, then run a
 269: # batch to process the individual files with their respected batch files

Comment on Document maintenance script Download Code

Replies are listed 'Best First'.
Re: Document maintenance script by chromatic (Archbishop) on Jun 16, 2001 at 03:53 UTC
Overall nice. There are a handful of idioms that would save typing though. First, when you're iterating through a list, you don't have to keep an index around: `my @items = (1, 2, 3, 4, 5); foreach my $item (@items) { print "Got item $item!\n"; }` [download] Next, you don't need to stringify a variable if you want to bind it to a regex. Third, there's a lot of duplication. From my skimming of the code, it's in your conditionals. There are plenty of ways to handle this, from stringing conditionals together to calling a subroutine. I'd do it all in just one regex, though: `if ($item =~ /^(foo\|bar\|baz)/) { # do several things }` [download] You can probably get rid of the '+' in your opens. It's pretty rare that you need both read and write access. The rest of it is pretty solid, though you might want to be careful calling subs with a leading ampersand... it'll pass along the contents of @_. I prefer `sub()` to pass no arguments explicitly. Update: Renamed to fit new title.	[reply] [d/l] [select]
Re: Document maintenance script by Dominus (Parson) on Jun 19, 2001 at 12:53 UTC
Ywo comments. First, I'd guess that there's way too much code here. I'd be surprised it half of it couldn't be eliminated. I may post a followup on this later. Second, I don't think this part could possibly work: `35: my @disk = <FILE>; 36: chomp @disk = <FILE>;` [download] since `@disk` will always be empty. Perhaps you want `chomp(my @disk = <FILE>)` instead. Update: Well, I was wrong about lines 35-36 not possibly working! It turns out that line 36 is parsed so that the result of `<FILE>` is assigned to `chomp`, rather than to `@disk`! (That is, it is parsed as `chomp(@disk) = <FILE>`, not `chomp(@disk = <FILE>)`.) In any event, the second assignment is useless, and the two lines should be replaced with one: `chomp(my @disk = <FILE>);` [download] In other news, I was right about there being too much code. I've cut `copy_from_root` from 98 lines to 26, and I'm about to move on to the rest of the program. -- Mark Dominus Perl Paraphernalia	[reply] [d/l] [select]
Re: Document maintenance script by CharlesClarkson (Curate) on Jun 21, 2001 at 02:14 UTC
2 questions: 1 - Is there anything in the file: 'c:/docu/ftproot.txt' when the program begins? 2 - You seem to be using files to pass info between the subs. Is there a particular reason for this? Charles K. Clarkson	[reply]
Re: Re: Document maintenance script by blacksmith (Hermit) on Jun 21, 2001 at 18:31 UTC
Thanks for the questions. Really helps me to think about what I am really doing with this script. For the answer to number one : I pride myself as someone who can give a valid reason within a timely manner for any thing that I do. This is one of those times that I am not very proud. The file is (or should be) empty when the program first starts, although there must be a file out there with this name only empty. I realize that there will be an initial 6 minute wait before the first file is copied to any of the other folders, but in the environment that this is running it will not be a huge concern. I do of course realize that as a programmer of Perl (if I would even go that far since I am so green to Perl) I should be trying to be as efficient as possible. I plan on looking into this in the near future. For answer number two : The only reason I actually have for doing this is due to my inexperience with Perl. I made the different files so that I could watch if my program was picking up the info and how it was reading it. I am sure as I get more hours under my belt I will trust my own programs enough not to rely on this. The program does work for me fine otherwise. I would like to go back through and revise the program but for now I am working on another project that has me slightly stumped and needs to be completed so it can be put into production immediately. Thanks again for the thought provoking questions and have a good day. Blacksmith.	[reply]
Re: Document maintenance script by CharlesClarkson (Curate) on Jun 25, 2001 at 07:41 UTC
Could you try running this and let me know if it functions properly. I combined a few subs and eliminated the delete sub. But I wasn't sure how to test it. #!/usr/bin/perl use strict; use warnings; use File::Copy; sub copy_from_root { my $ftp_dir = shift; opendir my $dir, $ftp_dir or die "Cannot open $ftp_dir: $!"; my %short_names; for my $file_name (grep /\.(?:txt\|doc\|mpd\|mta)$/i, readdir $dir) { my $daym = (localtime)[3]; my @dirs = ("c:/afis3too/$daym", 'c:/scripts/attempt', 'c:/rep +orts'); print $file_name; chomp $file_name; my $source = "$ftp_dir/$file_name"; $short_names{sprintf('%.6s.bat', lc $file_name)}++; if ($file_name =~ /^(?:afinv\|csinv\|sfinv)/i) { s/\.mta$/\.mpd/i; push @dirs, 'c:/invoice'; } elsif ($file_name =~ /\.doc$/i) { s/doc$/txt/ig; } elsif ($file_name =~ /\.mta$/i) { s/mta$/mpd/ig; } foreach my $dir (@dirs){ copy($source, "$dir/$file_name") or die "Cannot copy $dir/$file_name: $!"; } unlink $source or die "Cannot unlink $source: $!"; } return keys %short_names; } sub batch_files { my $batch_dir = shift; opendir my $dir, $batch_dir or die "Cannot open $batch_dir: $!"; my @files = grep /\.bat$/i, readdir $dir; return \@files; } sub run_the_batches { my ($short_names, $batch_files, $dir) = @_; my @matches; foreach my $short_name (@$short_names){ push @matches, grep /$short_name$/i, @$batch_files; print "Working...\n"; } system("$dir/$_") for @matches; } my $ftp_dir = 'c:/ftproot'; my $report_dir = 'c:/reports'; print "\n\n\n"; print " Robco Inc. Presents : \n\n\n"; print " The NEW, AMAZING, INCREDIBLE ....\n\n\n"; print " Robco Document Rotisserie!!!!!\n\n\n"; print "Just RENDER it, THEN don't REMEMBER it!!!!!\n\n"; print " It's just that easy.\n\n\n\n\n"; while (1) { print localtime, "\n"; print "sleeping .... ZzZzZzZzZz......\n"; sleep (10); print "OK! OK! .... I'm awake! .... I'm awake\n"; my $short_names = copy_from_root($ftp_dir); my $batch_files = batch_files($report_dir); run_the_batches($short_names, $batch_files, $report_dir); } [download] As mentioned above, I am unsure how to test all my changes. I'm sure there's a glitch or two. HTH, Charles K. Clarkson	[reply] [d/l]