#!/usr/bin/perl

############################################################################
### Copyright (C)  Tripodics.com
### Author:	Bruce A. Martin
### File Name:	upold.pl
### Purpose:	Make a file into the "old/" subdir
### Versions:
my $ver="8.0";
###	8.2	bam:2010/330	Fix filename err:  [-^
###	8.0	bam:2008/521	Revise (dirs, cgi-bin, etc.) and fix security
#			FORM METHOD=POST 
###	7	bam:2006/b15		(was moveold.pl )
###	0.1	bam:2005/b10		moveold.pl 
###	0.1e	bam:2005/211		mkdir.pl -- Create subdir (mkdir) (WUSB)
###	0.2d	bam:2004/10/17		modify.pl -- Work on parent dir	(for WUSB staffer subdirs)
###	0.2c	bam:2004/908		edit.pl
###	0.1b	bam:2004		(Ideas.)
###	0.1	bam:2004(428)04W	Store content, fetch into textarea.
#############################################################################

use strict;
use CGI qw/:standard/;

$| = 1;
print header;		# html format is permitted to output. 
print "<HTML>";


#### Get form parameters from URL.
my %in_para;
foreach (param()){
       	$in_para{$_} = join " ", param($_);
	# Multiple-values (checkbox) joined with blanks.
} 

my $content=$in_para{CONTENT};
my $h=$in_para{H};
#
my $dirname=	$in_para{SUBSUB};
$dirname="old";
my $filename=	$in_para{OLDFILE};
#
	#print "<LI>\@1:  $filename to $dirname/\n";

## Allowable characters only.
$filename =~ s|[^-A-Za-z0-9_/.]|_|g;	
#
	#print "<LI>\@2:  $filename to $dirname/\n";

## Security considerations.
$dirname =~ s|[.][.][.]*||g;			# Disallow multiple dots.
$dirname =~ s|^\.||g;				# Disallow leading dot.
$dirname =~ s|^/||g;				# Disallow leading slash.
$dirname =~ s|/\.||g;				# Disallow slash dot.
$dirname =~ s|//*|/|g;				# Disallow multiple slashes.
$dirname =~ s|~||g;				# Disallow tilde (~username).

	#print "<LI>\@3:  $filename to $dirname/";

######## PATHS & FILENAMES ########
my $pwd=	`pwd;`;
my $ppwd=	`cd ..; pwd;`;				# Parent directory.
my $sub=	`cd ..; basename \`pwd\` `;  chop $sub;

#### Set prefix to path. ####
my $name = $ENV { 'COMPUTERNAME' } ;
my $prepath = "../..";


#### Useful strings.
#
my $Q = '"';
#
my $TAB=	"	";
my $NBSP=	"&nbsp;";
my $SP4=	"&nbsp;&nbsp;&nbsp;&nbsp;"; 



#### Main processing.  #### 
#
	print "<HEAD><TITLE> /$sub/$dirname --  Move file to old/ </TITLE>\n";
	print "<BODY BGCOLOR=669CC33>\n";
	print "Move $filename to $dirname/";

	if ($dirname =~ /^\s*$/) { $dirname="."; }

	if ( -e "$prepath/$dirname") {
	} else {
		print "<P>Creating subdir:  $NBSP $sub/$dirname . . .";
		#### Create dir.
		mkdir "$prepath/$dirname" ;
		print "OK<BR><BR>";
	}

	if ( -e "$prepath/$dirname/$filename") {
		print "<H4>$sub/$dirname/$filename EXISTS already.  (Backup copy $filename~ will be made first.)</H4>\n";
	}


my $ll;
#$ll=`ls -l $prepath $prepath/$dirname`; print "<U>$prepath $prepath/$dirname</U><PRE>$ll</PRE>";

	#mv -b "$filename" "$dirname/";
	#mv -b "$filename $dirname/";
	print "cd $prepath;mv -b $filename $dirname/<BR>\n";
	`cd $prepath;mv -b $filename $dirname/`;
	print "<BR>DONE:  $?<BR>";
#$ll=`ls -l $prepath $prepath/$dirname`; print "<U>$prepath $prepath/$dirname</U><PRE>$ll</PRE>";

	#### Close this window.
	print "<FORM ACTION=$Q$Q METHOD=POST>\n";
	print "$SP4 <INPUT NAME=QUIT 
		TYPE=SUBMIT VALUE=${Q}Close this window$Q 
		onClick=${Q}window.close()$Q>\n";
	print "</FORM>\n";

	exit; 



############################################################################
######	Software developed & owned by Tripodics.   ########
####	Copyright 1996-2004 by Tripodics, All Rights Reserved.          ####
####	Tripodics Computing Service, POBox 456 Middle Island, NY 11953  ####
#+++	(Nonexclusive usage granted to WUSB, Stony Brook, NY.)          +++#
############################################################################



##############################  End of bamlib.inc  ###########################

