#!/usr/bin/perl our $VERSION = 0.9; use strict; use warnings; use Time::Format qw(%time); use File::Copy; use IPC::Open3; use IO::Handle; use Unix::PID; use Time::HiRes qw/time/; ########## NOW: my $FORMATTEDDATE = $time{'yyyymmdd-hhmmss'}; my $RENAME_MESSAGES = ''; my $BACKUP; # GIVE SOME HELP IF NEEDED: if(@ARGV == 0){ print STDERR qq{ Usage: scriptophrenia perlscript.pl arg1 arg2 ... argn scriptophrenia attempts to rename all output of a script (any files mentioned in the command line, and will attempt to find the targets of stdout and stderr redirects if in ~) so that they contain a timestamp, eg: $FORMATTEDDATE IF STDOUT and/or STDERR are redirected to a file within ~/ then the file will be renamed to contain the timestamp. If they are redirected to a file that cannot be found, then a message will be put to that handle, and it will be closed and reopened at a filename derived from the script and timestamp, e.g. ./hello.pl.$FORMATTEDDATE.stdout If redirecting STDOUT/STDERR, it helps if the program you're running auto-flushes its output, although scriptophrenia does wait some time for it. If renaming the file at the end of STDOUT/STDERR, scriptophrenia uses stat to get the ino and the runs find -inum to find it. It only looks in ~ so if the file is not findable in this path then scriptophrenia will close STDOUT and reopen it elsewhere as described above. Any files that are mentioned in the command line (\@ARGV) are treated in the following way: Before processing, ALL EXISTING FILES are copied to a hidden file whose name contains the timestamp of that file's mtime. Files that are updated (i.e. already existed before) are copied to a new file that contains the timestamp, e.g: copy results.csv, results.$FORMATTEDDATE.csv ; Files that a new (i.e. did not exist before) are renamed to a filename that contains the timestamp, e.g: rename results.csv, results.$FORMATTEDDATE.csv ; scriptophrenia also sends messages to stderr about what it's doing, and appends to .scriptophrenia.log in the current directory. This includes the names of all the copied files so that you can re-generate a command even if the files have since changed. Finally, you can put it in your path (I have it in ~/Dropbox/bin :-) and put #!/path/to/scriptophrenia at the top of your script instead of #!/usr/bin/perl or whatever. #!/usr/bin/perl can be in the second line and scriptophrenia will remove the first line during the file copy to the backup (which is actually the one it runs :-) Additionally, if you're trying to run a binary, scriptophrenia with try exec()ing /my/binary/executable --version > .executable..version once it's finished everything else, so you could have some verion info for your program. It doesn't try to copy it though. Examples: # Calling ls -la \$ ./scriptophrenia ls -la SCRIPTOPHRENIA: stderr looks like a terminal, so will treat it as one! SCRIPTOPHRENIA: stdout looks like a terminal, so will treat it as one! SCRIPTOPHRENIA: /bin/ls --version TO BE SAVED IN .ls-20101111-091434.version SCRIPTOPHRENIA: /bin/ls -la total 152 drwxr-xr-x 3 jbwills users 4096 Jan 13 11:06 . drwxrwxr-x 14 jbwills root 4096 Jan 13 09:44 .. -rw-r--r-- 1 jbwills users 5643 Jan 12 17:19 .command.log -rwxr-xr-x 1 jbwills users 309 Jan 13 10:46 .hello.pl-20110112-232401 -rw-r--r-- 1 jbwills users 105640 Jan 13 00:20 .ls-20101111-091434 -rw-r--r-- 1 jbwills users 356 Jan 13 11:08 .ls-20101111-091434.version -rw-r--r-- 1 jbwills users 640 Jan 13 11:08 .scriptophrenia.log drwxr-xr-x 2 jbwills users 4096 Jan 13 11:08 old-dev-files -rwxr-xr-x 1 jbwills users 10614 Jan 13 11:06 scriptophrenia \$ cat .ls-20101111-091434.version ls (GNU coreutils) 8.5 Packaged by Gentoo (8.5 (p1)) Copyright (C) 2010 Free Software Foundation, Inc. License GPLv3+: GNU GPL version 3 or later . This is free software: you are free to change and redistribute it. There is NO WARRANTY, to the extent permitted by law. Written by Richard M. Stallman and David MacKenzie. \$ tail -n 1 .scriptophrenia.log 20110113-114629 v0.9 ls -la stderr TREATED AS TERMINAL /bin/ls --version TO BE SAVED IN .ls-20101111-091434.version \$ /bin/ls -la /home/jbwills/Dropbox/work/scriptophrenia/ls.out.txt RENAMED TO /home/jbwills/Dropbox/work/scriptophrenia/ls.out.20110113-114629.txt # calling a perl script: \$ ./scriptophrenia old-dev-files/hello.pl foo bar > out SCRIPTOPHRENIA: stderr looks like a terminal, so will treat it as one! SCRIPTOPHRENIA: old-dev-files/hello.pl COPIED TO old-dev-files/.hello.pl-20110112-232401 SCRIPTOPHRENIA: old-dev-files/.hello.pl-20110112-232401 foo bar I was called with these args: foo bar SCRIPTOPHRENIA: bar RENAMED TO 20110113-115018.bar SCRIPTOPHRENIA: renaming /home/jbwills/Dropbox/work/scriptophrenia/out to /home/jbwills/Dropbox/work/scriptophrenia/20110113-115018.out \$ tail -n 1 .scriptophrenia.log 20110113-115018 v0.9 old-dev-files/hello.pl foo bar stderr TREATED AS TERMINAL old-dev-files/hello.pl COPIED TO old-dev-files/.hello.pl-20110112-232401 \$ old-dev-files/.hello.pl-20110112-232401 foo bar bar RENAMED TO 20110113-115018.bar /home/jbwills/Dropbox/work/scriptophrenia/out RENAMED TO /home/jbwills/Dropbox/work/scriptophrenia/20110113-115018.out Currently scriptophrenia accepts no options. (Suggestions welcome) scriptophrenia uses the following perl modules: File::Copy IPC::Open3 IO::Handle Time::Format Time::HiRes Unix::PID It also uses the program find Written by Jimi-Carlo Bukowski-Wills http://search.cpan.org/~jimi/ }; exit; } # FREEZE FOR THE LOG: my $ARGS = join(' ', @ARGV); # WE'LL REQUIRE THIS LATER... my $SCRIPT_TO_RUN = shift @ARGV; # REDIRECT STDOUT AND STDERR IF THEY'RE FILES my %HANDLES_TO_REDIRECT = ( stdout => {h=>*STDOUT,n=>undef,r=>undef}, stderr => {h=>*STDERR,n=>undef,r=>undef}, ); # REDIRECT STDERR AND STDOUT IF NECESSARY REDIRECT_HANDLES (); # COPY TO BACKUP (BASED ON MTIME) my ($SHELL, $PROGRAM, $PROGRAMVERSION, $VERSIONFILE); COPY_SCRIPT(); # WHAT FILES ARE THERE IN THE COMMAND LINE? my %FILES_IN_COMMAND_LINE_BEFORE_RUN = SCAN_ARGV_FOR_FILES(); # make mtime copies of them :-) COPY_FILES(); # WE'RE RUNNING THIS COMMAND... my @COMMAND = ($PROGRAM,@ARGV); unshift @COMMAND, $SHELL if defined $SHELL; # if second shebang was found... my $COMMAND = join(" ",@COMMAND); print STDERR "SCRIPTOPHRENIA: $COMMAND\n"; RUN_COMMAND(@COMMAND); $RENAME_MESSAGES .= "\t\$ ".$COMMAND; # NOW WHAT FILES ARE THERE IN THE COMMAND LINE? my %FILES_IN_COMMAND_LINE_AFTER_RUN = SCAN_ARGV_FOR_FILES(); SCAN_FOR_NEW_FILES_AND_RENAME(); # RENAME STDOUT AND STDERR FILES IF THEY WERE FOUND RENAME_FILES (); # MAKE A NOTE OF WHAT HAPPENED... open(my $COMMANDLOG, ">> .scriptophrenia.log") or die $!; print $COMMANDLOG "$FORMATTEDDATE\tv$VERSION\t$ARGS$RENAME_MESSAGES\n"; close($COMMANDLOG); # finally if(defined $PROGRAMVERSION && $PROGRAMVERSION == 0){ exec("$PROGRAM --version > $VERSIONFILE"); } sub SCAN_FOR_NEW_FILES_AND_RENAME { foreach (keys %FILES_IN_COMMAND_LINE_AFTER_RUN){ if(exists $FILES_IN_COMMAND_LINE_BEFORE_RUN{$_}){ # file was already there if($FILES_IN_COMMAND_LINE_BEFORE_RUN{$_} == $FILES_IN_COMMAND_LINE_AFTER_RUN{$_}){ # same mtime # do nothing! } else { # copy the file, rather than renaming... my $new = $_; $new =~ s/^(.*?)([^\.\/]*)$/$1$FORMATTEDDATE.$2/g; copy $_, $new; $RENAME_MESSAGES .= "\t$_ COPIED TO $new"; print STDERR "SCRIPTOPHRENIA: $_ COPIED TO $new\n"; } } else { # file is new, rename it my $new = $_; $new =~ s/^(.*?)([^\.\/]*)$/$1$FORMATTEDDATE.$2/g; rename $_, $new; $RENAME_MESSAGES .= "\t$_ RENAMED TO $new"; print STDERR "SCRIPTOPHRENIA: $_ RENAMED TO $new\n"; } } } sub COPY_SCRIPT { my $SCRIPT_TO_RUN_COPY = $SCRIPT_TO_RUN; if(! -f $SCRIPT_TO_RUN){ foreach my $PATH(split /\:/, $ENV{PATH}){ if(-f $PATH.'/'.$SCRIPT_TO_RUN){ $SCRIPT_TO_RUN = $PATH.'/'.$SCRIPT_TO_RUN; last; } } } $BACKUP = FILE_MTIME_NAME($SCRIPT_TO_RUN_COPY,$SCRIPT_TO_RUN); open(my $READH, $SCRIPT_TO_RUN) or die $!; my $READB; read($READH, $READB, 2); if($READB eq '#!'){ my $line = <$READH>; open(my $WRITEH,'>',$BACKUP) or die $!; print $WRITEH $line unless $line =~ /\/scriptophrenia\s*$/; #my $SECOND = <$READH>; #if($SECOND =~ /^#!(.*?)[\r\n]*$/){ # $SHELL = $1; #} #print $WRITEH $SECOND; while(<$READH>){ print $WRITEH $_; } close($WRITEH); close($READH); chmod 0755, $BACKUP; $PROGRAM = $BACKUP; $PROGRAM = './'.$PROGRAM unless $PROGRAM =~ /\//; print STDERR "SCRIPTOPHRENIA: $SCRIPT_TO_RUN COPIED TO $BACKUP\n"; $RENAME_MESSAGES .= "\t$SCRIPT_TO_RUN COPIED TO $BACKUP"; } else { # just schedule a --version run at the end of exverything else! close($READH); #copy($SCRIPT_TO_RUN, $BACKUP); $PROGRAM = $SCRIPT_TO_RUN; $PROGRAMVERSION = 0; $BACKUP =~ /([^\/]+)$/; $VERSIONFILE = $1.'.version'; print STDERR "SCRIPTOPHRENIA: $SCRIPT_TO_RUN --version TO BE SAVED IN $VERSIONFILE\n"; $RENAME_MESSAGES .= "\t$SCRIPT_TO_RUN --version TO BE SAVED IN $VERSIONFILE"; } } sub COPY_FILES { foreach (keys %FILES_IN_COMMAND_LINE_BEFORE_RUN){ COPY_FILE_MTIME($_); } } sub FILE_MTIME_NAME { my $FILE = shift; my $STATFILE = $FILE; if(@_){ $STATFILE = shift; } my $mtime = (stat $STATFILE)[9]; my $mfdate = $time{'yyyymmdd-hhmmss', $mtime}; my $BACKUP = $FILE; $BACKUP =~ s/^(.*?)([^\/]*)$/$1.$2-$mfdate/g; return $BACKUP; } sub COPY_FILE_MTIME { my $FILE = shift; my $BACKUP = FILE_MTIME_NAME($FILE); copy $FILE, $BACKUP; $RENAME_MESSAGES .= "\t$FILE COPIED TO $BACKUP"; print STDERR "SCRIPTOPHRENIA: $FILE COPIED TO $BACKUP\n"; return $BACKUP; } sub REDIRECT_HANDLES { foreach (keys %HANDLES_TO_REDIRECT){ REDIRECT_HANDLE($_); } } sub REDIRECT_HANDLE { my ($h) = @_; $HANDLES_TO_REDIRECT{$h}->{n} = GET_FILENAME_FROM_HANDLE($HANDLES_TO_REDIRECT{$h}->{h}); my $stdinfn = $HANDLES_TO_REDIRECT{$h}->{n}; if(defined $HANDLES_TO_REDIRECT{$h}->{n}){ if(! $HANDLES_TO_REDIRECT{$h}->{n}){ if(-t $HANDLES_TO_REDIRECT{$h}->{h}){ print STDERR "SCRIPTOPHRENIA: $h looks like a terminal, so will treat it as one!\n"; $RENAME_MESSAGES .= "\t$h TREATED AS TERMINAL"; } else { print STDERR "SCRIPTOPHRENIA: $h if a file with no name (could be outside your home directory?)\n" . "Will close $h and reopen as $SCRIPT_TO_RUN.$FORMATTEDDATE.$h\n"; print "$h was redirected to $SCRIPT_TO_RUN.$FORMATTEDDATE.out by scriptophrenia\n"; # print to STDOUT! close($HANDLES_TO_REDIRECT{$h}->{h}); open($HANDLES_TO_REDIRECT{$h}->{h},"> $SCRIPT_TO_RUN.$FORMATTEDDATE.out") or die $!; $RENAME_MESSAGES .= "\t$h REDIRECTED TO $SCRIPT_TO_RUN.$FORMATTEDDATE.out"; } } else { $HANDLES_TO_REDIRECT{$h}->{r} = $HANDLES_TO_REDIRECT{$h}->{n}; $HANDLES_TO_REDIRECT{$h}->{r} =~ s/^(.*?)([^\.\/]*)$/$1$FORMATTEDDATE.$2/g; } } } sub RENAME_FILES { foreach (keys %HANDLES_TO_REDIRECT){ RENAME_FILE($_); } } sub RENAME_FILE { my ($h) = @_; if(defined $HANDLES_TO_REDIRECT{$h}->{r}){ print STDERR "SCRIPTOPHRENIA: renaming $HANDLES_TO_REDIRECT{$h}->{n} to $HANDLES_TO_REDIRECT{$h}->{r}\n"; rename $HANDLES_TO_REDIRECT{$h}->{n} , $HANDLES_TO_REDIRECT{$h}->{r}; $RENAME_MESSAGES .= "\t$HANDLES_TO_REDIRECT{$h}->{n} RENAMED TO $HANDLES_TO_REDIRECT{$h}->{r}"; } } sub SCAN_ARGV_FOR_FILES { my %fn = (); foreach (@ARGV){ if(-f $_){ $fn{$_} = (stat $_)[9]; } } return %fn; } sub GET_FILENAME_FROM_HANDLE { my $fh = shift; if(-f $fh && ! -t $fh){ my $inum = (stat $fh)[1]; my $cmd = "find ~ -xdev -inum $inum -type f 2>/dev/null |"; open(F,$cmd) or die $!; my $find = ; close(F); return '' unless defined $find; $find =~ s/[\n\r]+//g; return $find; } } sub RUN_COMMAND { my $up = Unix::PID->new(); my $command = join(" ", @_); my $pid = open3(\*CHLD_IN, \*CHLD_OUT, \*CHLD_ERR, $command) or die $!; my $chin = new IO::Handle; my $chout = new IO::Handle; my $cherr = new IO::Handle; $chin->fdopen(fileno(CHLD_IN),"w") or die $!; $chout->fdopen(fileno(CHLD_OUT),"r") or die $!; $cherr->fdopen(fileno(CHLD_ERR),"r") or die $!; my $stdin = new IO::Handle; my $stdout = new IO::Handle; my $stderr = new IO::Handle; $stdin->fdopen(fileno(STDIN),"r") or die $!; $stdout->fdopen(fileno(STDOUT),"w") or die $!; $stderr->fdopen(fileno(STDERR),"w") or die $!; foreach ($stdin,$stdout,$stderr,$chin,$chout,$cherr){ $_->blocking(0); $_->autoflush(1); binmode($_); } my @info = $up->pid_info( $pid ); my $lasttime = time; my $buf; while(1){ if($chout->read($buf,1000)){ $stdout->write($buf,length($buf)); $stdout->flush; $lasttime = time; } if($cherr->read($buf,1000)){ $stderr->write($buf,length($buf)); $stderr->flush; $lasttime = time; } if($stdin->read($buf,1000)){ $chin->write($buf,length($buf)); $stdin->flush; $lasttime = time; } @info = $up->pid_info( $pid ); last if scalar(@info) == 0 && time > $lasttime + 0.1; } }