Annotation of loncom/publisher/loncfile.pm, revision 1.55

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to rename files, etc, in construction space
                      3: #
1.9       foxr        4: #  This file responds to the various buttons and events
                      5: #  in the top frame of the construction space directory.
                      6: #  Each event is processed in two phases.  The first phase
                      7: #  presents a page that describes the proposed action to the user
                      8: #  and requests confirmation.  The second phase commits the action
                      9: #  and displays a page showing the results of the action.
                     10: #
1.24      albertel   11: #
1.55    ! albertel   12: # $Id: loncfile.pm,v 1.54 2004/05/26 22:15:19 albertel Exp $
1.7       albertel   13: #
                     14: # Copyright Michigan State University Board of Trustees
                     15: #
                     16: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                     17: #
                     18: # LON-CAPA is free software; you can redistribute it and/or modify
                     19: # it under the terms of the GNU General Public License as published by
                     20: # the Free Software Foundation; either version 2 of the License, or
                     21: # (at your option) any later version.
                     22: #
                     23: # LON-CAPA is distributed in the hope that it will be useful,
                     24: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     25: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     26: # GNU General Public License for more details.
                     27: #
                     28: # You should have received a copy of the GNU General Public License
                     29: # along with LON-CAPA; if not, write to the Free Software
                     30: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     31: #
                     32: # /home/httpd/html/adm/gpl.txt
                     33: #
                     34: # http://www.lon-capa.org/
                     35: #
1.12      foxr       36: =pod
                     37: 
                     38: =head1 NAME
                     39: 
                     40: Apache::loncfile - Construction space file management.
                     41: 
                     42: =head1 SYNOPSIS
                     43:  
                     44:  Content handler for buttons on the top frame of the construction space 
                     45: directory.
                     46: 
                     47: =head1 INTRODUCTION
                     48: 
                     49:   loncfile is invoked when buttons in the top frame of the construction 
1.17      harris41   50: space directory listing are clicked.   All operations proceed in two phases.
1.12      foxr       51: The first phase describes to the user exactly what will be done.  If the user
                     52: confirms the operation, the second phase commits the operation and indicates
                     53: completion.  When the user dismisses the output of phase2, they are returned to
                     54: an "appropriate" directory listing in general.
                     55: 
                     56:     This is part of the LearningOnline Network with CAPA project
                     57: described at http://www.lon-capa.org.
                     58: 
                     59: =head2 Subroutines
                     60: 
                     61: =cut
1.1       www        62: 
                     63: package Apache::loncfile;
                     64: 
                     65: use strict;
                     66: use Apache::File;
1.15      foxr       67: use File::Basename;
1.1       www        68: use File::Copy;
1.18      foxr       69: use HTML::Entities();
1.1       www        70: use Apache::Constants qw(:common :http :methods);
                     71: use Apache::loncacc;
1.9       foxr       72: use Apache::Log ();
1.15      foxr       73: use Apache::lonnet;
1.33      www        74: use Apache::loncommon();
1.47      sakharuk   75: use Apache::lonlocal;
1.9       foxr       76: 
1.45      taceyjo1   77: my $DEBUG=0;
1.10      foxr       78: my $r;				# Needs to be global for some stuff RF.
1.12      foxr       79: 
                     80: =pod
                     81: 
                     82: =item Debug($request, $message)
                     83: 
1.17      harris41   84:   If debugging is enabled puts out a debugging message determined by the
1.12      foxr       85:   caller.  The debug message goes to the Apache error log file. Debugging
1.17      harris41   86:   is enabled by setting the module global DEBUG variable to nonzero (TRUE).
1.12      foxr       87: 
                     88:  Parameters:
                     89: 
                     90: =over 4
                     91:  
1.17      harris41   92: =item $request - The current request operation.
1.12      foxr       93: 
1.17      harris41   94: =item $message - The message to put in the log file.
1.12      foxr       95: 
                     96: =back
                     97:   
                     98:  Returns:
                     99:    nothing.
                    100: 
                    101: =cut
                    102: 
1.9       foxr      103: sub Debug {
1.12      foxr      104:   
1.55    ! albertel  105:     # Marshall the parameters.
1.12      foxr      106:   
1.55    ! albertel  107:     my $r       = shift;
        !           108:     my $log     = $r->log;
        !           109:     my $message = shift;
1.12      foxr      110:   
1.55    ! albertel  111:     # Put out the indicated message butonly if DEBUG is true.
1.12      foxr      112:   
1.55    ! albertel  113:     if ($DEBUG) {
        !           114: 	$r->log_reason($message);
        !           115:     }
1.12      foxr      116: }
                    117: 
                    118: =pod
                    119: 
                    120: =item URLToPath($url)
                    121: 
                    122:   Convert a URL to a file system path.
                    123:   
                    124:   In order to manipulate the construction space objects, it is necessary
                    125:   to access url identified objects a filespace objects.  This function
                    126:   translates a construction space URL to a file system path.
                    127:  Parameters:
                    128: 
                    129: =over 4
                    130: 
                    131: =item  Url    - string [in] The url to convert.
                    132:   
                    133: =back
                    134:   
                    135:  Returns:
                    136: 
                    137: =over 4
                    138: 
1.16      harris41  139: =item  The corresponding file system path. 
1.12      foxr      140: 
                    141: =back
                    142: 
                    143: Global References
                    144: 
                    145: =over 4
                    146: 
                    147: =item  $r      - Request object [in] Referenced in the &Debug calls.
                    148: 
                    149: =back
                    150: 
                    151: =cut
                    152: 
                    153: sub URLToPath {
1.55    ! albertel  154:     my $Url = shift;
        !           155:     &Debug($r, "UrlToPath got: $Url");
        !           156:     $Url=~ s/\/+/\//g;
        !           157:     $Url=~ s/^http\:\/\/[^\/]+//;
        !           158:     $Url=~ s/^\///;
        !           159:     $Url=~ s/(\~|priv\/)(\w+)\//\/home\/$2\/public_html\//;
        !           160:     &Debug($r, "Returning $Url \n");
        !           161:     return $Url;
1.12      foxr      162: }
                    163: 
1.36      www       164: sub url {
                    165:     my $fn=shift;
                    166:     $fn=~s/^\/home\/(\w+)\/public\_html/\/priv\/$1/;
                    167:     return $fn;
                    168: }
                    169: 
                    170: sub display {
                    171:     my $fn=shift;
1.43      albertel  172:     $fn=~s-^/home/(\w+)/public_html-/priv/$1-;
1.36      www       173:     return '<tt>'.$fn.'</tt>';
                    174: }
                    175: 
1.50      www       176: 
                    177: # see if the file is
                    178: # a) published (return 0 if not)
                    179: # b) if, so obsolete (return 0 if not)
                    180: 
                    181: sub obsolete_unpub {
                    182:     my ($user,$domain,$construct)=@_;
                    183:     my $published=$construct;
                    184:     $published=~
                    185: 	s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;
                    186:     if (-e $published) {
                    187: 	if (&Apache::lonnet::metadata($published,'obsolete')) {
                    188: 	    return 1;
                    189: 	}
                    190: 	return 0;
                    191:     } else {
                    192: 	return 1;
                    193:     }
                    194: }
                    195: 
                    196: 
                    197: 
1.12      foxr      198: =pod
                    199: 
1.39      www       200: =item exists($user, $domain, $file)
1.12      foxr      201: 
1.17      harris41  202:    Determine if a resource file name has been published or exists
1.12      foxr      203:    in the construction space.
                    204: 
                    205:  Parameters:
                    206: 
                    207: =over 4
                    208: 
                    209: =item  $user   - string [in] - Name of the user for which to check.
                    210: 
                    211: =item  $domain - string [in] - Name of the domain in which the resource
                    212:                           might have been published.
                    213: 
                    214: =item  $file   - string [in] - Name of the file.
                    215: 
                    216: =back
                    217: 
                    218: Returns:
                    219: 
                    220: =over 4
                    221: 
                    222: =item  string - Either where the resource exists as an html string that can
                    223:            be embedded in a dialog or an empty string if the resource
                    224:            does not exist.
                    225:   
                    226: =back
                    227: 
                    228: =cut
                    229: 
1.8       albertel  230: sub exists {
1.55    ! albertel  231:     my ($user, $domain, $construct) = @_;
        !           232:     my $published=$construct;
        !           233:     $published=~
        !           234: 	s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;
        !           235:     my $result='';    
        !           236:     if ( -d $construct ) {
        !           237: 	return &mt('Error: destination for operation is an existing directory.');
        !           238:     }
        !           239:     if ( -e $published) {
        !           240: 	$result.='<p><font color="red">'.&mt('Warning: target file exists, and has been published!').'</font></p>';
        !           241:     } elsif ( -e $construct) {
        !           242: 	$result.='<p><font color="red">'.&mt('Warning: target file exists!').'</font></p>';
        !           243:     }
        !           244:     return $result;
1.8       albertel  245: }
                    246: 
1.12      foxr      247: =pod
                    248: 
                    249: =item checksuffix($old, $new)
                    250:         
                    251:   Determine if a resource filename suffix (the stuff after the .) would change
                    252: as a result of this operation.
                    253: 
                    254:  Parameters:
                    255: 
                    256: =over 4
                    257: 
                    258: =item  $old   = string [in]  Previous filename.
                    259: 
                    260: =item  $new   = string [in]  Resultant filename.
                    261: 
                    262: =back
                    263: 
                    264:  Returns:
                    265: 
                    266: =over 4
                    267: 
1.17      harris41  268: =item    Empty string if everything worked.
1.12      foxr      269: 
                    270: =item    String containing an error message if there was a problem.
                    271: 
                    272: =back
                    273: 
                    274: =cut
                    275: 
1.8       albertel  276: sub checksuffix {
                    277:     my ($old,$new) = @_;
                    278:     my $result;
                    279:     my $oldsuffix;
                    280:     my $newsuffix;
                    281:     if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }
                    282:     if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
                    283:     if ($oldsuffix ne $newsuffix) {
1.12      foxr      284: 	$result.=
1.47      sakharuk  285:             '<p><font color="red">'.&mt('Warning: change of MIME type!').'</font></p>';
1.8       albertel  286:     }
                    287:     return $result;
                    288: }
1.32      albertel  289: 
                    290: sub cleanDest {
                    291:     my ($request,$dest)=@_;
                    292:     #remove bad characters
                    293:     if  ($dest=~/[\#\?&]/) {
1.47      sakharuk  294: 	$request->print("<p><font color=\"red\">".&mt('Invalid characters in requested name have been removed.')."</font></p>");
1.32      albertel  295: 	$dest=~s/[\#\?&]//g;
                    296:     }
                    297:     return $dest;
                    298: }
                    299: 
1.36      www       300: sub relativeDest {
                    301:     my ($fn,$newfilename,$uname)=@_;
                    302:     if ($newfilename=~/^\//) {
                    303: # absolute, simply add path
                    304: 	$newfilename='/home/'.$uname.'/public_html/';
                    305:     } else {
                    306: 	my $dir=$fn;
                    307: 	$dir=~s/\/[^\/]+$//;
                    308: 	$newfilename=$dir.'/'.$newfilename;
                    309:     }
                    310:     $newfilename=~s://+:/:g; # remove duplicate /
                    311:     while ($newfilename=~m:/\.\./:) {
                    312: 	$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
                    313:     }
                    314:     return $newfilename;
                    315: }
                    316: 
1.12      foxr      317: =pod
                    318: 
                    319: =item CloseForm1($request, $user, $file)
                    320: 
                    321:    Close of a form on the successful completion of phase 1 processing
                    322: 
                    323: Parameters:
                    324: 
                    325: =over 4
                    326: 
                    327: =item  $request - Apache Request Object [in] - Apache server request object.
                    328: 
1.13      foxr      329: =item  $cancelurl - the url to go to on cancel.
1.12      foxr      330: 
                    331: =back
                    332: 
                    333: =cut
                    334: 
                    335: sub CloseForm1 {
1.55    ! albertel  336:     my ($request,  $fn) = @_;
        !           337:     $request->print('<p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
        !           338:     $request->print('<form action="'.&url($fn).
        !           339: 		    '" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
1.12      foxr      340: }
                    341: 
                    342: 
                    343: =pod
                    344: 
                    345: =item CloseForm2($request, $user, $directory)
                    346: 
                    347:    Successfully close off the phase 2 form.
                    348: 
                    349: Parameters:
                    350: 
                    351: =over 4
                    352: 
                    353: =item   $request    - Apache Request object [in] - The request that is being
                    354:                  executed.
                    355: 
                    356: =item   $user       - string [in] - Name of the user that is initiating the
                    357:                  request.
                    358: 
                    359: =item   $directory  - string [in] - Directory in which the operation is 
                    360:                  being done relative to the top level construction space
                    361:                  directory.
                    362: 
                    363: =back
                    364: 
                    365: =cut
                    366: 
                    367: sub CloseForm2 {
1.55    ! albertel  368:     my ($request, $user, $fn) = @_;
        !           369:     $request->print('<h3><a href="'.&url($fn).'/">'.&mt('Done').'</a></h3>');
1.12      foxr      370: }
                    371: 
                    372: =pod
                    373: 
                    374: =item Rename1($request, $filename, $user, $domain, $dir)
                    375:  
                    376:    Perform phase 1 processing of the file rename operation.
                    377: 
                    378: Parameters:
                    379: 
                    380: =over 4
                    381: 
                    382: =item  $request   - Apache Request Object [in] The request object for the 
                    383: current request.
                    384: 
                    385: =item  $filename  - The filename relative to construction space.
                    386: 
                    387: =item  $user      - Name of the user making the request.
                    388: 
                    389: =item  $domain    - User login domain.
                    390: 
                    391: =item  $dir       - Directory specification of the path to the file.
                    392: 
                    393: =back
                    394: 
                    395: Side effects:
                    396: 
                    397: =over 4
                    398: 
                    399: =item A new form is displayed prompting for confirmation.  The newfilename
                    400: hidden field of this form is loaded with
                    401: new filename relative to the current directory ($dir).
                    402: 
                    403: =back
                    404: 
                    405: =cut  
                    406: 
                    407: sub Rename1 {
1.52      albertel  408:     my ($request, $user, $domain, $fn, $newfilename, $style) = @_;
1.36      www       409: 
                    410:     if(-e $fn) {
                    411: 	if($newfilename) {
1.42      albertel  412: 	    # is dest a dir
1.52      albertel  413: 	    if ($style eq 'move') {
                    414: 		if (-d $newfilename) {
                    415: 		    if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; }
                    416: 		}
1.42      albertel  417: 	    }
1.29      albertel  418: 	    if ($newfilename =~ m|/[^\.]+$|) {
1.36      www       419: 		#no extension add on original extension
                    420: 		if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {
1.24      albertel  421: 		    $newfilename.='.'.$1;
                    422: 		}
                    423: 	    }
1.36      www       424: 	    $request->print(&checksuffix($fn, $newfilename));
1.27      albertel  425: 	    #renaming a dir, delete the trailing /
1.39      www       426:             #remove second to last element for current dir
                    427: 	    if (-d $fn) {
1.53      www       428: 		$newfilename=~/\.(\w+)$/;
                    429: 		if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {
                    430: 		    $request->print('<br /><font color="red">'.
1.55    ! albertel  431: 				    &mt('Cannot change MIME type of a directory').
1.53      www       432: 				    '</font>'.
1.55    ! albertel  433: 				    '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
1.53      www       434: 		    return;
                    435: 		}
1.39      www       436: 		$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;
1.27      albertel  437: 	    }
1.42      albertel  438: 	    $newfilename=~s://+:/:g; # remove duplicate /
                    439: 	    while ($newfilename=~m:/\.\./:) {
                    440: 		$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
                    441: 	    }
1.39      www       442: 	    my $return=&exists($user, $domain, $newfilename);
1.21      albertel  443: 	    $request->print($return);
                    444: 	    if ($return =~/^Error:/) {
1.47      sakharuk  445: 		$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
1.21      albertel  446: 		return;
                    447: 	    }
1.50      www       448: 	    unless (&obsolete_unpub($user,$domain,$fn)) {
                    449: 		$request->print('<h3>'.&mt('Cannot rename or move non-obsolete published file').'</h3>'.
                    450: 				'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
                    451: 		return;
                    452: 	    }
1.52      albertel  453: 	    my $action;
                    454: 	    if ($style eq 'rename') {
                    455: 		$action=&mt('Rename');
                    456: 	    } else {
                    457: 		$action=&mt('Move');
                    458: 	    }
1.23      albertel  459: 	    $request->print('<input type="hidden" name="newfilename" value="'.
1.12      foxr      460: 			    $newfilename.
1.52      albertel  461: 			    '" /><p>'.$action.' '.&display($fn).
1.36      www       462: 			    '</tt><br />to '.&display($newfilename).'?</p>');
                    463: 	    &CloseForm1($request, $fn);
1.12      foxr      464: 	} else {
1.47      sakharuk  465: 	    $request->print('<p>'.&mt('No new filename specified.').'</p></form>');
1.12      foxr      466: 	    return;
                    467: 	}
                    468:     } else {
1.47      sakharuk  469: 	$request->print('<p> '.&mt('No such file').': '.&display($fn).'</p></form>');
1.12      foxr      470: 	return;
                    471:     }
                    472:     
                    473: }
1.55    ! albertel  474: 
1.12      foxr      475: =pod
                    476: 
                    477: =item Delete1
                    478: 
                    479:    Performs phase 1 processing of the delete operation.  In phase one
                    480:   we just check to be sure the file exists.
                    481: 
                    482: Parameters:
                    483: 
                    484: =over 4
                    485: 
1.36      www       486: =item   $request   - Apache Request Object [in] request object for the current 
1.12      foxr      487:                 request.
                    488: 
1.36      www       489: =item   $user      - string [in]  Name of the user initiating the request.
1.12      foxr      490: 
1.36      www       491: =item   $domain    - string [in]  Domain the initiating user is logged in as
1.13      foxr      492: 
1.36      www       493: =item   $filename  - string [in]  Source filename.
1.12      foxr      494: 
                    495: =back
                    496: 
                    497: =cut
                    498: 
                    499: sub Delete1 {
1.55    ! albertel  500:     my ($request, $user, $domain, $fn) = @_;
1.12      foxr      501: 
1.55    ! albertel  502:     if( -e $fn) {
        !           503: 	$request->print('<input type="hidden" name="newfilename" value="'.
        !           504: 			$fn.'"/>');
        !           505: 	unless (&obsolete_unpub($user,$domain,$fn)) {
        !           506: 	    $request->print('<h3>'.&mt('Cannot delete non-obsolete published file').'</h3>'.
        !           507: 			    '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
        !           508: 	    return;
        !           509: 	}
        !           510: 	$request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>');
        !           511: 	&CloseForm1($request, $fn);
        !           512:     } else {
        !           513: 	$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
1.50      www       514:     }
1.12      foxr      515: }
                    516: 
                    517: =pod
                    518: 
                    519: =item Copy1($request, $user, $domain, $filename, $newfilename)
                    520: 
                    521:    Performs phase 1 processing of the construction space copy command.
1.17      harris41  522:    Ensure that the source file exists.  Ensure that a destination exists,
                    523:    also warn if the destination already exists.
1.12      foxr      524: 
                    525: Parameters:
                    526: 
                    527: =over 4
                    528: 
                    529: =item   $request   - Apache Request Object [in] request object for the current 
                    530:                 request.
                    531: 
                    532: =item   $user      - string [in]  Name of the user initiating the request.
                    533: 
                    534: =item   $domain    - string [in]  Domain the initiating user is logged in as
                    535: 
1.36      www       536: =item   $fn  - string [in]  Source filename.
1.12      foxr      537: 
                    538: =item   $newfilename-string [in]  Destination filename.
                    539: 
                    540: =back
                    541: 
                    542: =cut
                    543: 
                    544: sub Copy1 {
1.42      albertel  545:     my ($request, $user, $domain, $fn, $newfilename) = @_;
1.12      foxr      546: 
1.42      albertel  547:     if(-e $fn) {
                    548: 	# is dest a dir
                    549: 	if (-d $newfilename) {
                    550: 	    if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; }
                    551: 	}
                    552: 	if ($newfilename =~ m|/[^\.]+$|) {
                    553: 	    #no extension add on original extension
                    554: 	    if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {	$newfilename.='.'.$1; }
                    555: 	} 
                    556: 	$newfilename=~s://+:/:g; # remove duplicate /
                    557: 	while ($newfilename=~m:/\.\./:) {
                    558: 	    $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
                    559: 	}
                    560: 	$request->print(&checksuffix($fn,$newfilename));
                    561: 	my $return=&exists($user, $domain, $newfilename);
                    562: 	$request->print($return);
                    563: 	if ($return =~/^Error:/) {
1.47      sakharuk  564: 	    $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
1.42      albertel  565: 	    return;
                    566: 	}
                    567: 	$request->print('<input type="hidden" name="newfilename" value="'.
                    568: 			$newfilename.
1.47      sakharuk  569: 			'" /><p>'.&mt('Copy').' '.&display($fn).'<br />to '.
1.42      albertel  570: 			&display($newfilename).'?</p>');
                    571: 	&CloseForm1($request, $fn);
                    572:     } else {
1.47      sakharuk  573: 	$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
1.21      albertel  574:     }
1.19      albertel  575: }
                    576: 
                    577: =pod
                    578: 
1.12      foxr      579: =item NewDir1
                    580:  
                    581:   Does all phase 1 processing of directory creation:
                    582:   Ensures that the user provides a new directory name,
                    583:   and that the directory does not already exist.
                    584: 
                    585: Parameters:
                    586: 
                    587: =over 4
                    588: 
                    589: =item   $request  - Apache Request Object [in] - Server request object for the
1.17      harris41  590:                current url.
1.12      foxr      591: 
                    592: =item   $username - Name of the user that is requesting the directory creation.
                    593: 
1.36      www       594: =item $domain - Domain user is in
                    595: 
                    596: =item   $fn     - source file.
1.12      foxr      597: 
                    598: =item   $newdir   - Name of the directory to be created; path relative to the 
                    599:                top level of construction space.
                    600: =back
                    601: 
                    602: Side Effects:
                    603: 
                    604: =over 4
                    605: 
                    606: =item A new form is displayed.  Clicking on the confirmation button
                    607: causes the newdir operation to transition into phase 2.  The hidden field
                    608: "newfilename" is set with the construction space path to the new directory.
                    609: 
                    610: 
                    611: =back
                    612: 
                    613: =cut
                    614: 
                    615: 
1.55    ! albertel  616: sub NewDir1 {
        !           617:     my ($request, $username, $domain, $fn, $newfilename, $mode) = @_;
        !           618: 
        !           619:     my $result=&exists($username,$domain,$newfilename);
        !           620:     if ($result) {
        !           621: 	$request->print('<font color="red">'.$result.'</font></form>');
        !           622:     } else {
        !           623: 	if ($mode eq 'testbank') {
        !           624: 	    $request->print('<input type="hidden" name="callingmode" value="testbank">');
        !           625: 	} elsif ($mode eq 'imsimport') {
        !           626: 	    $request->print('<input type="hidden" name="callingmode" value="imsimport">');
        !           627: 	}
        !           628: 	$request->print('<input type="hidden" name="newfilename" value="'.
        !           629: 			$newfilename.'" /><p>'.&mt('Make new directory').' '.
        !           630: 			&display($newfilename).'?</p>');
        !           631: 	&CloseForm1($request, $fn);
        !           632:     }
1.12      foxr      633: }
                    634: 
1.44      taceyjo1  635: 
                    636: sub Decompress1 {
1.55    ! albertel  637:     my ($request, $user, $domain, $fn) = @_;
        !           638:     if( -e $fn) {
1.44      taceyjo1  639:    	$request->print('<input type="hidden" name="newfilename" value="'.$fn.'"/>');
1.47      sakharuk  640:    	$request->print('<p>'.&mt('Decompress').' '.&display($fn).'?</p>');
1.44      taceyjo1  641:    	&CloseForm1($request, $fn);
1.55    ! albertel  642:     } else {
        !           643: 	$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
        !           644:     }
1.44      taceyjo1  645: }
1.55    ! albertel  646: 
1.12      foxr      647: =pod
                    648: 
1.22      albertel  649: =item NewFile1
                    650:  
                    651:   Does all phase 1 processing of file creation:
                    652:   Ensures that the user provides a new filename, adds proper extension
                    653:   if needed and that the file does not already exist, if it is a html,
                    654:   problem, page, or sequence, it then creates a form link to hand the
                    655:   actual creation off to the proper handler.
                    656: 
                    657: Parameters:
                    658: 
                    659: =over 4
                    660: 
                    661: =item   $request  - Apache Request Object [in] - Server request object for the
                    662:                current url.
                    663: 
                    664: =item   $username - Name of the user that is requesting the directory creation.
                    665: 
                    666: =item   $domain   - Name of the domain of the user
                    667: 
1.36      www       668: =item   $fn      - Source file name
1.22      albertel  669: 
                    670: =item   $newfilename
                    671:                   - Name of the file to be created; no path information
                    672: =back
                    673: 
                    674: Side Effects:
                    675: 
                    676: =over 4
                    677: 
                    678: =item 2 new forms are displayed.  Clicking on the confirmation button
                    679: causes the browser to attempt to load the specfied URL, allowing the
1.36      www       680: proper handler to take care of file creation. There is also a Cancel
1.22      albertel  681: button which returns you to the driectory listing you came from
                    682: 
                    683: =back
                    684: 
                    685: =cut
                    686: 
                    687: sub NewFile1 {
1.36      www       688:     my ($request, $user, $domain, $fn, $newfilename) = @_;
1.22      albertel  689: 
                    690:     if ($ENV{'form.action'} =~ /new(.+)file/) {
                    691: 	my $extension=$1;
1.40      www       692: 
                    693:         ##Informs User (name).(number).(extension) not allowed 
                    694: 	if($newfilename =~ /\.(\d+)\.(\w+)$/){
                    695: 	    $r->print('<font color="red">'.$newfilename.
1.47      sakharuk  696: 		      ' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').')'.
                    697: 		      ' '.&mt('Not Allowed').'</font>');
1.40      www       698: 	    return;
                    699: 	}
1.22      albertel  700: 	if ($newfilename !~ /\Q.$extension\E$/) {
1.26      albertel  701: 	    if ($newfilename =~ m|^[^\.]*\.([^\.]+)$|) {
                    702: 		#already has an extension strip it and add in expected one
                    703: 		$newfilename =~ s|.([^\.]+)$||;
                    704: 	    }
1.22      albertel  705: 	    $newfilename.=".$extension";
                    706: 	}
1.31      albertel  707:     }
1.39      www       708:     my $result=&exists($user,$domain,$newfilename);
                    709:     if($result) {
                    710: 	$request->print('<font color="red">'.$result.'</font></form>');
                    711:     } else {
1.47      sakharuk  712: 	$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');
1.22      albertel  713: 	$request->print('</form>');
1.36      www       714: 	$request->print('<form action="'.&url($newfilename).
1.47      sakharuk  715: 			'" method="POST"><p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
1.36      www       716: 	$request->print('<form action="'.&url($fn).
1.47      sakharuk  717: 			'" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
1.22      albertel  718:     }
                    719: }
                    720: 
                    721: =pod
                    722: 
1.12      foxr      723: =item phaseone($r, $fn, $uname, $udom)
                    724: 
                    725:   Peforms phase one processing of the request.  In phase one, error messages
                    726: are returned if the request cannot be performed (e.g. attempts to manipulate
                    727: files that are nonexistent).  If the operation can be performed, what is
                    728: about to be done will be presented to the user for confirmation.  If the
                    729: user confirms the request, then phase two is executed, the action 
                    730: performed and reported to the user.
                    731: 
                    732:  Parameters:
                    733: 
                    734: =over 4
                    735: 
                    736: =item $r  - request object [in] - The Apache request being executed.
                    737: 
                    738: =item $fn = string [in] - The filename being manipulated by the 
                    739:                              request.
                    740: 
                    741: =item $uname - string [in] Name of user logged in and doing this action.
                    742: 
1.17      harris41  743: =item $udom  - string [in] Domain name under which the user logged in. 
1.12      foxr      744: 
                    745: =back
                    746: 
                    747: =cut
1.8       albertel  748: 
1.1       www       749: sub phaseone {
1.55    ! albertel  750:     my ($r,$fn,$uname,$udom)=@_;
1.12      foxr      751:   
1.55    ! albertel  752:     my $newfilename=&cleanDest($r,$ENV{'form.newfilename'});
        !           753:     $newfilename=&relativeDest($fn,$newfilename,$uname);
        !           754:     $r->print('<form action="/adm/cfile" method="post">'.
        !           755: 	      '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
        !           756: 	      '<input type="hidden" name="phase" value="two" />'.
        !           757: 	      '<input type="hidden" name="action" value="'.$ENV{'form.action'}.'" />');
1.12      foxr      758:   
1.55    ! albertel  759:     if ($ENV{'form.action'} eq 'rename') {
        !           760: 	&Rename1($r, $uname, $udom, $fn, $newfilename, 'rename');
        !           761:     } elsif ($ENV{'form.action'} eq 'move') {
        !           762: 	&Rename1($r, $uname, $udom, $fn, $newfilename, 'move');
        !           763:     } elsif ($ENV{'form.action'} eq 'delete') { 
        !           764: 	&Delete1($r, $uname, $udom, $fn);
        !           765:     } elsif ($ENV{'form.action'} eq 'decompress') {
        !           766: 	&Decompress1($r, $uname, $udom, $fn);
        !           767:     } elsif ($ENV{'form.action'} eq 'copy') { 
        !           768: 	if($newfilename) {
        !           769: 	    &Copy1($r, $uname, $udom, $fn, $newfilename);
        !           770: 	} else {
        !           771: 	    $r->print('<p>'.&mt('No new filename specified.').'</p></form>');
        !           772: 	}
        !           773:     } elsif ($ENV{'form.action'} eq 'newdir') {
        !           774: 	my $mode = '';
        !           775: 	if (exists($ENV{'form.callingmode'}) ) {
        !           776: 	    $mode = $ENV{'form.callingmode'};
        !           777: 	}   
        !           778: 	&NewDir1($r, $uname, $udom, $fn, $newfilename, $mode);
        !           779:     }  elsif ($ENV{'form.action'} eq 'newfile' ||
        !           780: 	      $ENV{'form.action'} eq 'newhtmlfile' ||
        !           781: 	      $ENV{'form.action'} eq 'newproblemfile' ||
        !           782: 	      $ENV{'form.action'} eq 'newpagefile' ||
        !           783: 	      $ENV{'form.action'} eq 'newsequencefile' ||
        !           784: 	      $ENV{'form.action'} eq 'newrightsfile' ||
        !           785: 	      $ENV{'form.action'} eq 'newstyfile' ||
        !           786: 	      $ENV{'form.action'} eq 'Select Action') {
        !           787: 	if ($newfilename) {
        !           788: 	    &NewFile1($r, $uname, $udom, $fn, $newfilename);
        !           789: 	} else {
        !           790: 	    $r->print('<p>'.&mt('No new filename specified.').'</p></form>');
        !           791: 	}
        !           792:     }
1.12      foxr      793: }
                    794: 
                    795: =pod
                    796: 
                    797: =item Rename2($request, $user, $directory, $oldfile, $newfile)
                    798: 
1.17      harris41  799: Performs phase 2 processing of a rename reequest.   This is where the
1.12      foxr      800: actual rename is performed.
                    801: 
                    802: Parameters
                    803: 
                    804: =over 4
                    805: 
                    806: =item $request - Apache request object [in] The request being processed.
                    807: 
                    808: =item $user  - string [in] The name of the user initiating the request.
                    809: 
                    810: =item $directory - string [in] The name of the directory relative to the
                    811:                  construction space top level of the renamed file.
                    812: 
                    813: =item $oldfile - Name of the file.
                    814: 
                    815: =item $newfile - Name of the new file.
                    816: 
                    817: =back
                    818: 
                    819: Returns:
                    820: 
                    821: =over 4
                    822: 
                    823: =item 1 Success.
                    824: 
                    825: =item 0 Failure.
                    826: 
                    827: =cut
                    828: 
                    829: sub Rename2 {
                    830: 
1.55    ! albertel  831:     my ($request, $user, $directory, $oldfile, $newfile) = @_;
1.12      foxr      832: 
1.55    ! albertel  833:     &Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile.
        !           834: 	   " new file ".$newfile."\n");
        !           835:     &Debug($request, "Target is: ".$directory.'/'.
        !           836: 	   $newfile);
        !           837:     if (-e $oldfile) {
        !           838: 
        !           839: 	my $oRN=$oldfile;
        !           840: 	my $nRN=$newfile;
        !           841: 	unless (rename($oldfile,$newfile)) {
        !           842: 	    $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
        !           843: 	    return 0;
        !           844: 	}
        !           845: 	## If old name.(extension) exits, move under new name.
        !           846: 	## If it doesn't exist and a new.(extension) exists  
        !           847: 	## delete it (only concern when renaming over files)
        !           848: 	my $tmp1=$oRN.'.meta';
        !           849: 	my $tmp2=$nRN.'.meta';
        !           850: 	if(-e $tmp1){
        !           851: 	    unless(rename($tmp1,$tmp2)){ }
        !           852: 	} elsif(-e $tmp2){
        !           853: 	    unlink $tmp2;
        !           854: 	}
        !           855: 	$tmp1=$oRN.'.save';
        !           856: 	$tmp2=$nRN.'.save';
        !           857: 	if(-e $tmp1){
        !           858: 	    unless(rename($tmp1,$tmp2)){ }
        !           859: 	} elsif(-e $tmp2){
        !           860: 	    unlink $tmp2;
        !           861: 	}
        !           862: 	$tmp1=$oRN.'.log';
        !           863: 	$tmp2=$nRN.'.log';
        !           864: 	if(-e $tmp1){
        !           865: 	    unless(rename($tmp1,$tmp2)){ }
        !           866: 	} elsif(-e $tmp2){
        !           867: 	    unlink $tmp2;
        !           868: 	}
        !           869: 	$tmp1=$oRN.'.bak';
        !           870: 	$tmp2=$nRN.'.bak';
        !           871: 	if(-e $tmp1){
        !           872: 	    unless(rename($tmp1,$tmp2)){ }
        !           873: 	} elsif(-e $tmp2){
        !           874: 	    unlink $tmp2;
        !           875: 	}
        !           876:     } else {
        !           877: 	$request->print("<p> ".&mt('No such file').": ".&display($oldfile).'</p></form>');
        !           878: 	return 0;
        !           879:     }
        !           880:     return 1;
1.12      foxr      881: }
1.55    ! albertel  882: 
1.12      foxr      883: =pod
                    884: 
                    885: =item Delete2($request, $user, $filename)
                    886: 
                    887:   Performs phase two of a delete.  The user has confirmed that they want 
                    888: to delete the selected file.   The file is deleted and the results of the
                    889: delete attempt are indicated.
                    890: 
                    891: Parameters:
                    892: 
                    893: =over 4
                    894: 
                    895: =item $request - Apache Request object [in] the request object for the current
                    896:                  delete operation.
                    897: 
                    898: =item $user    - string [in]  The name of the user initiating the delete
                    899:                  request.
                    900: 
1.17      harris41  901: =item $filename - string [in] The name of the file, relative to construction
                    902:                   space, to delete.
1.12      foxr      903: 
                    904: =back
                    905: 
                    906: Returns:
                    907:   1 - success.
                    908:   0 - Failure.
                    909: 
                    910: =cut
                    911: 
                    912: sub Delete2 {
1.55    ! albertel  913:     my ($request, $user, $filename) = @_;
        !           914:     if(opendir DIR, $filename) { 
        !           915: 	my @files=readdir(DIR);
        !           916: 	shift @files; shift @files; # takes off . and ..
        !           917: 	if(@files) { 
        !           918: 	    $request->print('<font color="red"> '.&mt('Error: Directory Non Empty').'</font>'); 
        !           919: 	    return 0;
        !           920: 	} else {   
        !           921: 	    if(-e $filename) {
        !           922: 		unless(rmdir($filename)) {
        !           923: 		    $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
        !           924: 		    return 0;
        !           925: 		}
        !           926: 	    } else {
        !           927: 		$request->print('<p> '.&mt('No such file').'. </p></form>');
        !           928: 		return 0;
        !           929: 	    }
        !           930: 	}
1.48      taceyjo1  931:     } else {
1.55    ! albertel  932: 	if(-e $filename) {
        !           933: 	    unless(unlink($filename)) {
        !           934: 		$request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
        !           935: 		return 0;
        !           936: 	    }
        !           937: 	} else {
        !           938: 	    $request->print('<p> '.&mt('No such file').'. </p></form>');
        !           939: 	    return 0;
1.46      taceyjo1  940: 	}
1.55    ! albertel  941:     }
        !           942:     return 1;
1.12      foxr      943: }
                    944: 
                    945: =pod
                    946: 
                    947: =item Copy2($request, $username, $dir, $oldfile, $newfile)
                    948: 
                    949:    Performs phase 2 of a copy.  The file is copied and the status 
                    950:    of that copy is reported back to the user.
                    951: 
                    952: =over 4
                    953: 
                    954: =item $request - Apache request object [in]; the apache request currently
                    955:                  being executed.
                    956: 
                    957: =item $username - string [in] Name of the user who is requesting the copy.
                    958: 
                    959: =item $dir - string [in] Directory path relative to the construction space
                    960:              of the destination file.
                    961: 
                    962: =item $oldfile - string [in] Name of the source file.
                    963: 
                    964: =item $newfile - string [in] Name of the destination file.
                    965: 
                    966: 
                    967: =back
                    968: 
                    969: Returns 0 failure, and 0 successs.
                    970: 
                    971: =cut
1.1       www       972: 
1.12      foxr      973: sub Copy2 {
                    974:     my ($request, $username, $dir, $oldfile, $newfile) = @_;
                    975:     &Debug($request ,"Will try to copy $oldfile to $newfile");
                    976:     if(-e $oldfile) {
                    977: 	unless (copy($oldfile, $newfile)) {
1.47      sakharuk  978: 	    $request->print('<font color="red"> '.&mt('copy Error').': '.$!.'</font>');
1.12      foxr      979: 	    return 0;
                    980: 	} else {
1.14      foxr      981: 	    unless (chmod(0660, $newfile)) {
1.47      sakharuk  982: 		$request->print('<font color="red"> '.&mt('chmod error').': '.$!.'</font>');
1.14      foxr      983: 		return 0;
                    984: 	    }
1.12      foxr      985: 	    return 1;
                    986: 	}
1.11      albertel  987:     } else {
1.47      sakharuk  988: 	$request->print('<p> '.&mt('No such file').' </p>');
1.12      foxr      989: 	return 0;
1.11      albertel  990:     }
1.12      foxr      991:     return 1;
                    992: }
1.55    ! albertel  993: 
1.12      foxr      994: =pod
                    995: 
                    996: =item NewDir2($request, $user, $newdirectory)
1.1       www       997: 
1.12      foxr      998: 	Performs phase 2 processing of directory creation.  This involves creating the directory and
                    999: 	reporting the results of that creation to the user.
                   1000: 	
                   1001: Parameters:
                   1002: =over 4
                   1003: 
                   1004: =item $request  - Apache request object [in].  Object representing the current HTTP request.
                   1005: 
                   1006: =item $user - string [in] The name of the user that is initiating the request.
                   1007: 
                   1008: =item $newdirectory - string [in] The full path of the directory being created.
                   1009: 
                   1010: =back
                   1011: 
                   1012: Returns 0 - failure 1 - success.
                   1013: 
                   1014: =cut
1.8       albertel 1015: 
1.12      foxr     1016: sub NewDir2 {
1.55    ! albertel 1017:     my ($request, $user, $newdirectory) = @_;
1.12      foxr     1018:   
1.55    ! albertel 1019:     unless(mkdir($newdirectory, 02770)) {
        !          1020: 	$request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
        !          1021: 	return 0;
        !          1022:     }
        !          1023:     unless(chmod(02770, ($newdirectory))) {
        !          1024: 	$request->print('<font color="red"> '.&mt('Error').': '.$!.'</font>');
        !          1025: 	return 0;
        !          1026:     }
        !          1027:     return 1;
1.1       www      1028: }
1.55    ! albertel 1029: 
1.44      taceyjo1 1030: sub decompress2 {
1.55    ! albertel 1031:     my ($r, $user, $dir, $file) = @_;
        !          1032:     &Apache::lonnet::appenv('cgi.file' => $file);
        !          1033:     &Apache::lonnet::appenv('cgi.dir' => $dir);
        !          1034:     my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
        !          1035:     $r->print($result);
        !          1036:     &Apache::lonnet::delenv('cgi.file');
        !          1037:     &Apache::lonnet::delenv('cgi.dir');
        !          1038:     return 1;
1.44      taceyjo1 1039: }
1.55    ! albertel 1040: 
1.12      foxr     1041: =pod
                   1042: 
                   1043: =item phasetwo($r, $fn, $uname, $udom)
                   1044: 
                   1045:    Controls the phase 2 processing of file management
                   1046:    requests for construction space.  In phase one, the user
                   1047:    was asked to confirm the operation.  In phase 2, the operation
                   1048:    is performed and the result is shown.
                   1049: 
                   1050:   The strategy is to break out the processing into specific action processors
                   1051:   named action2 where action is the requested action and the 2 denotes 
                   1052:   phase 2 processing.
                   1053: 
                   1054: Parameters:
                   1055: 
                   1056: =over 4
                   1057: 
                   1058: =item  $r     - Apache Request object [in] The request object for this httpd
                   1059:            transaction.
                   1060: 
                   1061: =item  $fn    - string [in]  A filename indicating the object that is being
                   1062:            manipulated.
                   1063: 
                   1064: =item  $uname - string [in] The name of the user initiating the file management
                   1065:            request.
                   1066: 
                   1067: =item  $udom  - string  [in] The login domain of the user initiating the
                   1068:            file management request.
                   1069: =back
                   1070: 
                   1071: =cut
                   1072: 
1.1       www      1073: sub phasetwo {
                   1074:     my ($r,$fn,$uname,$udom)=@_;
1.12      foxr     1075:     
1.9       foxr     1076:     &Debug($r, "loncfile - Entering phase 2 for $fn");
1.12      foxr     1077:     
                   1078:     # Break down the file into it's component pieces.
                   1079:     
1.27      albertel 1080:     my $dir;		# Directory path
                   1081:     my $main;		# Filename.
                   1082:     my $suffix;		# Extension.
1.46      taceyjo1 1083:     if ($fn=~m:(.*)/([^/]+):) {
1.27      albertel 1084: 	$dir=$1;		# Directory path
                   1085: 	$main=$2;		# Filename.
1.54      albertel 1086:     }
                   1087:     if($main=~m:\.(\w+)$:){ # Fixes problems with filenames with no extensions
                   1088: 	$main=$`; #This is what is before the match (.) so it's just the main filename, yea it's nasty
                   1089: 	$suffix=$1; #This is the actually filename extension if it exists
                   1090:     }
1.12      foxr     1091:     my $dest;                   # On success this is where we'll go.
1.9       foxr     1092:     
1.55    ! albertel 1093:     &Debug($r,"loncfile::phase2 dir = $dir main = $main suffix = $suffix");
        !          1094:     &Debug($r,"    newfilename = ".$ENV{'form.newfilename'});
1.9       foxr     1095: 
                   1096:     my $conspace=$fn;
1.12      foxr     1097:     
1.55    ! albertel 1098:     &Debug($r,"loncfile::phase2 Full construction space name: $conspace");
1.12      foxr     1099:     
1.55    ! albertel 1100:     &Debug($r,"loncfie::phase2 action is $ENV{'form.action'}");
1.12      foxr     1101:     
                   1102:     # Select the appropriate processing sub.
1.44      taceyjo1 1103:     if ($ENV{'form.action'} eq 'decompress') { 
                   1104: 	$main .= '.';
                   1105: 	$main .= $suffix;
1.55    ! albertel 1106: 	if(!&decompress2($r, $uname, $dir, $main)) {
        !          1107: 	    return ;
        !          1108: 	}
        !          1109: 	$dest = $dir."/.";
1.44      taceyjo1 1110:     } elsif ($ENV{'form.action'} eq 'rename') { # Rename.
1.12      foxr     1111: 	if($ENV{'form.newfilename'}) {
1.27      albertel 1112: 	    if (!defined($dir)) {
                   1113: 		$fn=~m:^(.*)/:;
1.55    ! albertel 1114: 		$dir=$1; 
1.27      albertel 1115: 	    }
1.12      foxr     1116: 	    if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
                   1117: 		return;
                   1118: 	    }
1.38      www      1119: 	    $dest = &url($ENV{'form.newfilename'});
1.12      foxr     1120: 	}
1.5       www      1121:     } elsif ($ENV{'form.action'} eq 'delete') { 
1.12      foxr     1122: 	if(!&Delete2($r, $uname, $ENV{'form.newfilename'})) {
                   1123: 	    return ;
                   1124: 	}
                   1125: 	# Once a resource is deleted, we just list the directory that
                   1126: 	# previously held it.
                   1127: 	#
1.20      albertel 1128: 	$dest = $dir."/.";		# Parent dir.
1.5       www      1129:     } elsif ($ENV{'form.action'} eq 'copy') { 
1.12      foxr     1130: 	if($ENV{'form.newfilename'}) {
                   1131: 	    if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
1.44      taceyjo1 1132: 		return ;
1.55    ! albertel 1133: 	    }
1.12      foxr     1134: 	    $dest = $ENV{'form.newfilename'};
1.55    ! albertel 1135:      	} else {
1.47      sakharuk 1136: 	    $r->print('<p>'.&mt('No New filename specified').'</p></form>');
1.12      foxr     1137: 	    return;
                   1138: 	}
                   1139: 	
1.5       www      1140:     } elsif ($ENV{'form.action'} eq 'newdir') {
1.38      www      1141:         my $newdir= $ENV{'form.newfilename'};
1.12      foxr     1142: 	if(!&NewDir2($r, $uname, $newdir)) {
                   1143: 	    return;
                   1144: 	}
1.55    ! albertel 1145: 	$dest = $newdir."/";
1.12      foxr     1146:     }
1.51      raeburn  1147:     if ( ($ENV{'form.action'} eq 'newdir') && ($ENV{'form.phase'} eq 'two') && ( ($ENV{'form.callingmode'} eq 'testbank') || ($ENV{'form.callingmode'} eq 'imsimport') ) ) {
1.55    ! albertel 1148: 	$r->print('<h3><a href="javascript:self.close()">'.&mt('Done').'</a></h3>');
1.51      raeburn  1149:     } else {
1.55    ! albertel 1150: 	$r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>');
1.51      raeburn  1151:     }
1.1       www      1152: }
                   1153: 
                   1154: sub handler {
                   1155: 
1.55    ! albertel 1156:     $r=shift;
1.1       www      1157: 
1.9       foxr     1158: 
1.55    ! albertel 1159:     &Debug($r, "loncfile.pm - handler entered");
        !          1160:     &Debug($r, " filename: ".$ENV{'form.filename'});
        !          1161:     &Debug($r, " newfilename: ".$ENV{'form.newfilename'});
1.36      www      1162: #
                   1163: # Determine the root filename
                   1164: # This could come in as "filename", which actually is a URL, or
                   1165: # as "qualifiedfilename", which is indeed a real filename in filesystem
                   1166: #
1.55    ! albertel 1167:     my $fn;
1.1       www      1168: 
1.55    ! albertel 1169:     if ($ENV{'form.filename'}) {
1.44      taceyjo1 1170: 	&Debug($r, "test: $ENV{'form.filename'}");
1.55    ! albertel 1171: 	$fn=&Apache::lonnet::unescape($ENV{'form.filename'});
        !          1172: 	$fn=&URLToPath($fn);
        !          1173:     }  elsif($ENV{'QUERY_STRING'} && $ENV{'form.phase'} ne 'two') {  
        !          1174: 	#Just hijack the script only the first time around to inject the
        !          1175: 	#correct information for further processing
        !          1176: 	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress']);
        !          1177: 	$fn=&Apache::lonnet::unescape($ENV{'form.decompress'});
1.44      taceyjo1 1178: 	$fn=&URLToPath($fn);
                   1179: 	$ENV{'form.action'}="decompress";
1.55    ! albertel 1180:     } elsif ($ENV{'form.qualifiedfilename'}) {
        !          1181: 	$fn=$ENV{'form.qualifiedfilename'};
        !          1182:     } else {
        !          1183: 	&Debug($r, "loncfile::handler - no form.filename");
        !          1184: 	$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
        !          1185: 		       ' unspecified filename for cfile', $r->filename); 
        !          1186: 	return HTTP_NOT_FOUND;
        !          1187:     }
1.44      taceyjo1 1188: 
1.55    ! albertel 1189:     unless ($fn) { 
        !          1190: 	&Debug($r, "loncfile::handler - doctored url is empty");
        !          1191: 	$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
        !          1192: 		       ' trying to cfile non-existing file', $r->filename); 
        !          1193: 	return HTTP_NOT_FOUND;
        !          1194:     } 
1.1       www      1195: 
                   1196: # ----------------------------------------------------------- Start page output
1.55    ! albertel 1197:     my $uname;
        !          1198:     my $udom;
        !          1199: 
        !          1200:     ($uname,$udom)=
        !          1201: 	&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
        !          1202:     &Debug($r, 
        !          1203: 	   "loncfile::handler constructaccess uname = $uname domain = $udom");
        !          1204:     unless (($uname) && ($udom)) {
        !          1205: 	$r->log_reason($uname.' at '.$udom.
        !          1206: 		       ' trying to manipulate file '.$ENV{'form.filename'}.
        !          1207: 		       ' ('.$fn.') - not authorized', 
        !          1208: 		       $r->filename); 
        !          1209: 	return HTTP_NOT_ACCEPTABLE;
        !          1210:     }
        !          1211: 
1.1       www      1212: 
1.55    ! albertel 1213:     &Apache::loncommon::content_type($r,'text/html');
        !          1214:     $r->send_http_header;
        !          1215: 
        !          1216:     if ( ($ENV{'form.action'} eq 'newdir') && ($ENV{'form.phase'} eq 'two') && ( ($ENV{'form.callingmode'} eq 'testbank') || ($ENV{'form.callingmode'} eq 'imsimport') ) ) {
        !          1217: 	my $newdirname = $ENV{'form.newfilename'};
        !          1218: 	$r->print('<html><head><title>LON-CAPA Construction Space</title><script language="Javascript">');
        !          1219: 	$r->print(qq|
1.51      raeburn  1220: function writeDone() {
                   1221:     var winName = window.opener
                   1222:     window.focus();
                   1223:     winName.document.dataForm.newdir.value = "$newdirname"
                   1224:     setTimeout("self.close()",10000)
                   1225: }
                   1226:   </script>
                   1227:   </head>|);
1.55    ! albertel 1228: 	my $loaditem = 'onLoad="writeDone()"';
        !          1229: 	$r->print(&Apache::loncommon::bodytag('Construction Space File Operation','',$loaditem));
        !          1230:     } else {
        !          1231: 	$r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
        !          1232: 	$r->print(&Apache::loncommon::bodytag('Construction Space File Operation'));
        !          1233:     }
1.1       www      1234: 
                   1235:   
1.55    ! albertel 1236:     $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
1.1       www      1237:   
1.55    ! albertel 1238:     if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
        !          1239: 	$r->print('<h3><font color="red">'.&mt('Co-Author').': '.$uname.' at '.$udom.
        !          1240: 		  '</font></h3>');
        !          1241:     }
        !          1242: 
        !          1243: 
        !          1244:     &Debug($r, "loncfile::handler Form action is $ENV{'form.action'} ");
        !          1245:     if ($ENV{'form.action'} eq 'delete') {
        !          1246:       	$r->print('<h3>'.&mt('Delete').'</h3>');
        !          1247:     } elsif ($ENV{'form.action'} eq 'rename') {
        !          1248: 	$r->print('<h3>'.&mt('Rename').'</h3>');
        !          1249:     } elsif ($ENV{'form.action'} eq 'move') {
        !          1250: 	$r->print('<h3>'.&mt('Move').'</h3>');
        !          1251:     } elsif ($ENV{'form.action'} eq 'newdir') {
        !          1252: 	$r->print('<h3>'.&mt('New Directory').'</h3>');
        !          1253:     } elsif ($ENV{'form.action'} eq 'decompress') {
        !          1254: 	$r->print('<h3>'.&mt('Decompress').'</h3>');
        !          1255:     } elsif ($ENV{'form.action'} eq 'copy') {
        !          1256: 	$r->print('<h3>'.&mt('Copy').'</h3>');
        !          1257:     } elsif ($ENV{'form.action'} eq 'newfile' ||
        !          1258: 	     $ENV{'form.action'} eq 'newhtmlfile' ||
        !          1259: 	     $ENV{'form.action'} eq 'newproblemfile' ||
        !          1260: 	     $ENV{'form.action'} eq 'newpagefile' ||
        !          1261: 	     $ENV{'form.action'} eq 'newsequencefile' ||
        !          1262: 	     $ENV{'form.action'} eq 'newrightsfile' ||
        !          1263: 	     $ENV{'form.action'} eq 'newstyfile' ||
        !          1264: 	     $ENV{'form.action'} eq 'Select Action' ) {
        !          1265: 	$r->print('<h3>'.&mt('New Resource').'</h3>');
        !          1266:     } else {
        !          1267: 	$r->print('<p>'.&mt('Unknown Action').' '.$ENV{'form.action'}.' </p></body></html>');
        !          1268: 	return OK;  
        !          1269:     }
        !          1270:     if ($ENV{'form.phase'} eq 'two') {
        !          1271: 	&Debug($r, "loncfile::handler  entering phase2");
        !          1272: 	&phasetwo($r,$fn,$uname,$udom);
        !          1273:     } else {
        !          1274: 	&Debug($r, "loncfile::handler  entering phase1");
        !          1275: 	&phaseone($r,$fn,$uname,$udom);
        !          1276:     }
1.1       www      1277: 
1.55    ! albertel 1278:     $r->print('</body></html>');
        !          1279:     return OK;  
1.1       www      1280: }
                   1281: 
                   1282: 1;
                   1283: __END__
1.9       foxr     1284: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>