#!/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 <ino> 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.<mtimestamp>.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 <http://gnu.org/licenses/gpl.html>.
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 <jimicarlo\@gmail.com> 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 = <F>;
      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;
   }
}