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

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.47    ! sakharuk   12: # $Id: loncfile.pm,v 1.46 2003/12/13 19:54:16 taceyjo1 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:   
                    105:   # Marshall the parameters.
                    106:   
                    107:   my $r       = shift;
                    108:   my $log     = $r->log;
                    109:   my $message = shift;
                    110:   
1.22      albertel  111:   # Put out the indicated message butonly if DEBUG is true.
1.12      foxr      112:   
                    113:   if ($DEBUG) {
1.46      taceyjo1  114:   $r->log_reason($message);
1.12      foxr      115:   }
                    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 {
                    154:   my $Url = shift;
                    155:   &Debug($r, "UrlToPath got: $Url");
1.37      www       156:   $Url=~ s/\/+/\//g;
1.12      foxr      157:   $Url=~ s/^http\:\/\/[^\/]+//;
1.35      www       158:   $Url=~ s/^\///;
                    159:   $Url=~ s/(\~|priv\/)(\w+)\//\/home\/$2\/public_html\//;
1.12      foxr      160:   &Debug($r, "Returning $Url \n");
                    161:   return $Url;
                    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.12      foxr      176: =pod
                    177: 
1.39      www       178: =item exists($user, $domain, $file)
1.12      foxr      179: 
1.17      harris41  180:    Determine if a resource file name has been published or exists
1.12      foxr      181:    in the construction space.
                    182: 
                    183:  Parameters:
                    184: 
                    185: =over 4
                    186: 
                    187: =item  $user   - string [in] - Name of the user for which to check.
                    188: 
                    189: =item  $domain - string [in] - Name of the domain in which the resource
                    190:                           might have been published.
                    191: 
                    192: =item  $file   - string [in] - Name of the file.
                    193: 
                    194: =back
                    195: 
                    196: Returns:
                    197: 
                    198: =over 4
                    199: 
                    200: =item  string - Either where the resource exists as an html string that can
                    201:            be embedded in a dialog or an empty string if the resource
                    202:            does not exist.
                    203:   
                    204: =back
                    205: 
                    206: =cut
                    207: 
1.8       albertel  208: sub exists {
1.39      www       209:   my ($user, $domain, $construct) = @_;
                    210:   my $published=$construct;
                    211:   $published=~
                    212: s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;
                    213:   my $result='';    
1.21      albertel  214:   if ( -d $construct ) {
1.47    ! sakharuk  215:       return &mt('Error: destination for operation is an existing directory.');
1.21      albertel  216:   }
1.12      foxr      217:   if ( -e $published) {
1.47    ! sakharuk  218:       $result.='<p><font color="red">'.&mt('Warning: target file exists, and has been published!').'</font></p>';
1.36      www       219:   } elsif ( -e $construct) {
1.47    ! sakharuk  220:       $result.='<p><font color="red">'.&mt('Warning: target file exists!').'</font></p>';
1.21      albertel  221:   }
1.12      foxr      222:   return $result;
                    223: 
1.8       albertel  224: }
                    225: 
1.12      foxr      226: =pod
                    227: 
                    228: =item checksuffix($old, $new)
                    229:         
                    230:   Determine if a resource filename suffix (the stuff after the .) would change
                    231: as a result of this operation.
                    232: 
                    233:  Parameters:
                    234: 
                    235: =over 4
                    236: 
                    237: =item  $old   = string [in]  Previous filename.
                    238: 
                    239: =item  $new   = string [in]  Resultant filename.
                    240: 
                    241: =back
                    242: 
                    243:  Returns:
                    244: 
                    245: =over 4
                    246: 
1.17      harris41  247: =item    Empty string if everything worked.
1.12      foxr      248: 
                    249: =item    String containing an error message if there was a problem.
                    250: 
                    251: =back
                    252: 
                    253: =cut
                    254: 
1.8       albertel  255: sub checksuffix {
                    256:     my ($old,$new) = @_;
                    257:     my $result;
                    258:     my $oldsuffix;
                    259:     my $newsuffix;
                    260:     if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }
                    261:     if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
                    262:     if ($oldsuffix ne $newsuffix) {
1.12      foxr      263: 	$result.=
1.47    ! sakharuk  264:             '<p><font color="red">'.&mt('Warning: change of MIME type!').'</font></p>';
1.8       albertel  265:     }
                    266:     return $result;
                    267: }
1.32      albertel  268: 
                    269: sub cleanDest {
                    270:     my ($request,$dest)=@_;
                    271:     #remove bad characters
                    272:     if  ($dest=~/[\#\?&]/) {
1.47    ! sakharuk  273: 	$request->print("<p><font color=\"red\">".&mt('Invalid characters in requested name have been removed.')."</font></p>");
1.32      albertel  274: 	$dest=~s/[\#\?&]//g;
                    275:     }
                    276:     return $dest;
                    277: }
                    278: 
1.36      www       279: sub relativeDest {
                    280:     my ($fn,$newfilename,$uname)=@_;
                    281:     if ($newfilename=~/^\//) {
                    282: # absolute, simply add path
                    283: 	$newfilename='/home/'.$uname.'/public_html/';
                    284:     } else {
                    285: 	my $dir=$fn;
                    286: 	$dir=~s/\/[^\/]+$//;
                    287: 	$newfilename=$dir.'/'.$newfilename;
                    288:     }
                    289:     $newfilename=~s://+:/:g; # remove duplicate /
                    290:     while ($newfilename=~m:/\.\./:) {
                    291: 	$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
                    292:     }
                    293:     return $newfilename;
                    294: }
                    295: 
1.12      foxr      296: =pod
                    297: 
                    298: =item CloseForm1($request, $user, $file)
                    299: 
                    300:    Close of a form on the successful completion of phase 1 processing
                    301: 
                    302: Parameters:
                    303: 
                    304: =over 4
                    305: 
                    306: =item  $request - Apache Request Object [in] - Apache server request object.
                    307: 
1.13      foxr      308: =item  $cancelurl - the url to go to on cancel.
1.12      foxr      309: 
                    310: =back
                    311: 
                    312: =cut
                    313: 
                    314: sub CloseForm1 {
1.36      www       315:    my ($request,  $fn) = @_;
1.47    ! sakharuk  316:    $request->print('<p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
1.36      www       317:    $request->print('<form action="'.&url($fn).
1.47    ! sakharuk  318:      '" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
1.12      foxr      319: }
                    320: 
                    321: 
                    322: =pod
                    323: 
                    324: =item CloseForm2($request, $user, $directory)
                    325: 
                    326:    Successfully close off the phase 2 form.
                    327: 
                    328: Parameters:
                    329: 
                    330: =over 4
                    331: 
                    332: =item   $request    - Apache Request object [in] - The request that is being
                    333:                  executed.
                    334: 
                    335: =item   $user       - string [in] - Name of the user that is initiating the
                    336:                  request.
                    337: 
                    338: =item   $directory  - string [in] - Directory in which the operation is 
                    339:                  being done relative to the top level construction space
                    340:                  directory.
                    341: 
                    342: =back
                    343: 
                    344: =cut
                    345: 
                    346: sub CloseForm2 {
1.36      www       347:   my ($request, $user, $fn) = @_;
1.47    ! sakharuk  348:   $request->print('<h3><a href="'.&url($fn).'/">'.&mt('Done').'</a></h3>');
1.12      foxr      349: }
                    350: 
                    351: =pod
                    352: 
                    353: =item Rename1($request, $filename, $user, $domain, $dir)
                    354:  
                    355:    Perform phase 1 processing of the file rename operation.
                    356: 
                    357: Parameters:
                    358: 
                    359: =over 4
                    360: 
                    361: =item  $request   - Apache Request Object [in] The request object for the 
                    362: current request.
                    363: 
                    364: =item  $filename  - The filename relative to construction space.
                    365: 
                    366: =item  $user      - Name of the user making the request.
                    367: 
                    368: =item  $domain    - User login domain.
                    369: 
                    370: =item  $dir       - Directory specification of the path to the file.
                    371: 
                    372: =back
                    373: 
                    374: Side effects:
                    375: 
                    376: =over 4
                    377: 
                    378: =item A new form is displayed prompting for confirmation.  The newfilename
                    379: hidden field of this form is loaded with
                    380: new filename relative to the current directory ($dir).
                    381: 
                    382: =back
                    383: 
                    384: =cut  
                    385: 
                    386: sub Rename1 {
1.36      www       387:     my ($request, $user, $domain, $fn, $newfilename) = @_;
                    388: 
                    389:     if(-e $fn) {
                    390: 	if($newfilename) {
1.42      albertel  391: 	    # is dest a dir
                    392: 	    if (-d $newfilename) {
                    393: 		if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; }
                    394: 	    }
1.29      albertel  395: 	    if ($newfilename =~ m|/[^\.]+$|) {
1.36      www       396: 		#no extension add on original extension
                    397: 		if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {
1.24      albertel  398: 		    $newfilename.='.'.$1;
                    399: 		}
                    400: 	    }
1.36      www       401: 	    $request->print(&checksuffix($fn, $newfilename));
1.27      albertel  402: 	    #renaming a dir, delete the trailing /
1.39      www       403:             #remove second to last element for current dir
                    404: 	    if (-d $fn) {
                    405: 		$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;
1.27      albertel  406: 	    }
1.42      albertel  407: 	    $newfilename=~s://+:/:g; # remove duplicate /
                    408: 	    while ($newfilename=~m:/\.\./:) {
                    409: 		$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
                    410: 	    }
1.39      www       411: 	    my $return=&exists($user, $domain, $newfilename);
1.21      albertel  412: 	    $request->print($return);
                    413: 	    if ($return =~/^Error:/) {
1.47    ! sakharuk  414: 		$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
1.21      albertel  415: 		return;
                    416: 	    }
1.23      albertel  417: 	    $request->print('<input type="hidden" name="newfilename" value="'.
1.12      foxr      418: 			    $newfilename.
1.47    ! sakharuk  419: 			    '" /><p>'.&mt('Rename').' '.&display($fn).
1.36      www       420: 			    '</tt><br />to '.&display($newfilename).'?</p>');
                    421: 	    &CloseForm1($request, $fn);
1.12      foxr      422: 	} else {
1.47    ! sakharuk  423: 	    $request->print('<p>'.&mt('No new filename specified.').'</p></form>');
1.12      foxr      424: 	    return;
                    425: 	}
                    426:     } else {
1.47    ! sakharuk  427: 	$request->print('<p> '.&mt('No such file').': '.&display($fn).'</p></form>');
1.12      foxr      428: 	return;
                    429:     }
                    430:     
                    431: }
                    432: =pod
                    433: 
                    434: =item Delete1
                    435: 
                    436:    Performs phase 1 processing of the delete operation.  In phase one
                    437:   we just check to be sure the file exists.
                    438: 
                    439: Parameters:
                    440: 
                    441: =over 4
                    442: 
1.36      www       443: =item   $request   - Apache Request Object [in] request object for the current 
1.12      foxr      444:                 request.
                    445: 
1.36      www       446: =item   $user      - string [in]  Name of the user initiating the request.
1.12      foxr      447: 
1.36      www       448: =item   $domain    - string [in]  Domain the initiating user is logged in as
1.13      foxr      449: 
1.36      www       450: =item   $filename  - string [in]  Source filename.
1.12      foxr      451: 
                    452: =back
                    453: 
                    454: =cut
                    455: 
                    456: sub Delete1 {
1.36      www       457:   my ($request, $user, $domain, $fn) = @_;
1.12      foxr      458: 
1.36      www       459:   if( -e $fn) {
1.23      albertel  460:     $request->print('<input type="hidden" name="newfilename" value="'.
1.36      www       461: 		    $fn.'"/>');
1.47    ! sakharuk  462:     $request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>');
1.36      www       463:     &CloseForm1($request, $fn);
1.12      foxr      464:   } else {
1.47    ! sakharuk  465:     $request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
1.12      foxr      466:   }
                    467: }
                    468: 
                    469: =pod
                    470: 
                    471: =item Copy1($request, $user, $domain, $filename, $newfilename)
                    472: 
                    473:    Performs phase 1 processing of the construction space copy command.
1.17      harris41  474:    Ensure that the source file exists.  Ensure that a destination exists,
                    475:    also warn if the destination already exists.
1.12      foxr      476: 
                    477: Parameters:
                    478: 
                    479: =over 4
                    480: 
                    481: =item   $request   - Apache Request Object [in] request object for the current 
                    482:                 request.
                    483: 
                    484: =item   $user      - string [in]  Name of the user initiating the request.
                    485: 
                    486: =item   $domain    - string [in]  Domain the initiating user is logged in as
                    487: 
1.36      www       488: =item   $fn  - string [in]  Source filename.
1.12      foxr      489: 
                    490: =item   $newfilename-string [in]  Destination filename.
                    491: 
                    492: =back
                    493: 
                    494: =cut
                    495: 
                    496: sub Copy1 {
1.42      albertel  497:     my ($request, $user, $domain, $fn, $newfilename) = @_;
1.12      foxr      498: 
1.42      albertel  499:     if(-e $fn) {
                    500: 	# is dest a dir
                    501: 	if (-d $newfilename) {
                    502: 	    if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; }
                    503: 	}
                    504: 	if ($newfilename =~ m|/[^\.]+$|) {
                    505: 	    #no extension add on original extension
                    506: 	    if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {	$newfilename.='.'.$1; }
                    507: 	} 
                    508: 	$newfilename=~s://+:/:g; # remove duplicate /
                    509: 	while ($newfilename=~m:/\.\./:) {
                    510: 	    $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
                    511: 	}
                    512: 	$request->print(&checksuffix($fn,$newfilename));
                    513: 	my $return=&exists($user, $domain, $newfilename);
                    514: 	$request->print($return);
                    515: 	if ($return =~/^Error:/) {
1.47    ! sakharuk  516: 	    $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
1.42      albertel  517: 	    return;
                    518: 	}
                    519: 	$request->print('<input type="hidden" name="newfilename" value="'.
                    520: 			$newfilename.
1.47    ! sakharuk  521: 			'" /><p>'.&mt('Copy').' '.&display($fn).'<br />to '.
1.42      albertel  522: 			&display($newfilename).'?</p>');
                    523: 	&CloseForm1($request, $fn);
                    524:     } else {
1.47    ! sakharuk  525: 	$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
1.21      albertel  526:     }
1.19      albertel  527: }
                    528: 
                    529: =pod
                    530: 
1.12      foxr      531: =item NewDir1
                    532:  
                    533:   Does all phase 1 processing of directory creation:
                    534:   Ensures that the user provides a new directory name,
                    535:   and that the directory does not already exist.
                    536: 
                    537: Parameters:
                    538: 
                    539: =over 4
                    540: 
                    541: =item   $request  - Apache Request Object [in] - Server request object for the
1.17      harris41  542:                current url.
1.12      foxr      543: 
                    544: =item   $username - Name of the user that is requesting the directory creation.
                    545: 
1.36      www       546: =item $domain - Domain user is in
                    547: 
                    548: =item   $fn     - source file.
1.12      foxr      549: 
                    550: =item   $newdir   - Name of the directory to be created; path relative to the 
                    551:                top level of construction space.
                    552: =back
                    553: 
                    554: Side Effects:
                    555: 
                    556: =over 4
                    557: 
                    558: =item A new form is displayed.  Clicking on the confirmation button
                    559: causes the newdir operation to transition into phase 2.  The hidden field
                    560: "newfilename" is set with the construction space path to the new directory.
                    561: 
                    562: 
                    563: =back
                    564: 
                    565: =cut
                    566: 
                    567: 
                    568: sub NewDir1
                    569: {
1.36      www       570:   my ($request, $username, $domain, $fn, $newfilename) = @_;
1.12      foxr      571: 
1.39      www       572:   my $result=&exists($username,$domain,$newfilename);
                    573:   if ($result) {
                    574:     $request->print('<font color="red">'.$result.'</font></form>');
                    575:   } else {
1.23      albertel  576:     $request->print('<input type="hidden" name="newfilename" value="'.
1.47    ! sakharuk  577: 		    $newfilename.'" /><p>'.&mt('Make new directory').' '.
1.36      www       578: 		    &display($newfilename).'?</p>');
                    579:     &CloseForm1($request, $fn);
1.12      foxr      580:   }
                    581: }
                    582: 
1.44      taceyjo1  583: 
                    584: sub Decompress1 {
                    585:    my ($request, $user, $domain, $fn) = @_;
                    586:    if( -e $fn) {
                    587:    	$request->print('<input type="hidden" name="newfilename" value="'.$fn.'"/>');
1.47    ! sakharuk  588:    	$request->print('<p>'.&mt('Decompress').' '.&display($fn).'?</p>');
1.44      taceyjo1  589:    	&CloseForm1($request, $fn);
                    590:    	} else {
1.47    ! sakharuk  591:        		$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
1.44      taceyjo1  592:      	  }
                    593: }
1.12      foxr      594: =pod
                    595: 
1.22      albertel  596: =item NewFile1
                    597:  
                    598:   Does all phase 1 processing of file creation:
                    599:   Ensures that the user provides a new filename, adds proper extension
                    600:   if needed and that the file does not already exist, if it is a html,
                    601:   problem, page, or sequence, it then creates a form link to hand the
                    602:   actual creation off to the proper handler.
                    603: 
                    604: Parameters:
                    605: 
                    606: =over 4
                    607: 
                    608: =item   $request  - Apache Request Object [in] - Server request object for the
                    609:                current url.
                    610: 
                    611: =item   $username - Name of the user that is requesting the directory creation.
                    612: 
                    613: =item   $domain   - Name of the domain of the user
                    614: 
1.36      www       615: =item   $fn      - Source file name
1.22      albertel  616: 
                    617: =item   $newfilename
                    618:                   - Name of the file to be created; no path information
                    619: =back
                    620: 
                    621: Side Effects:
                    622: 
                    623: =over 4
                    624: 
                    625: =item 2 new forms are displayed.  Clicking on the confirmation button
                    626: causes the browser to attempt to load the specfied URL, allowing the
1.36      www       627: proper handler to take care of file creation. There is also a Cancel
1.22      albertel  628: button which returns you to the driectory listing you came from
                    629: 
                    630: =back
                    631: 
                    632: =cut
                    633: 
                    634: 
                    635: sub NewFile1 {
1.36      www       636:     my ($request, $user, $domain, $fn, $newfilename) = @_;
1.22      albertel  637: 
                    638:     if ($ENV{'form.action'} =~ /new(.+)file/) {
                    639: 	my $extension=$1;
1.40      www       640: 
                    641:         ##Informs User (name).(number).(extension) not allowed 
                    642: 	if($newfilename =~ /\.(\d+)\.(\w+)$/){
                    643: 	    $r->print('<font color="red">'.$newfilename.
1.47    ! sakharuk  644: 		      ' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').')'.
        !           645: 		      ' '.&mt('Not Allowed').'</font>');
1.40      www       646: 	    return;
                    647: 	}
1.22      albertel  648: 	if ($newfilename !~ /\Q.$extension\E$/) {
1.26      albertel  649: 	    if ($newfilename =~ m|^[^\.]*\.([^\.]+)$|) {
                    650: 		#already has an extension strip it and add in expected one
                    651: 		$newfilename =~ s|.([^\.]+)$||;
                    652: 	    }
1.22      albertel  653: 	    $newfilename.=".$extension";
                    654: 	}
1.31      albertel  655:     }
1.39      www       656:     my $result=&exists($user,$domain,$newfilename);
                    657:     if($result) {
                    658: 	$request->print('<font color="red">'.$result.'</font></form>');
                    659:     } else {
1.47    ! sakharuk  660: 	$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');
1.22      albertel  661: 	$request->print('</form>');
1.36      www       662: 	$request->print('<form action="'.&url($newfilename).
1.47    ! sakharuk  663: 			'" method="POST"><p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
1.36      www       664: 	$request->print('<form action="'.&url($fn).
1.47    ! sakharuk  665: 			'" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
1.22      albertel  666:     }
                    667: }
                    668: 
                    669: =pod
                    670: 
1.12      foxr      671: =item phaseone($r, $fn, $uname, $udom)
                    672: 
                    673:   Peforms phase one processing of the request.  In phase one, error messages
                    674: are returned if the request cannot be performed (e.g. attempts to manipulate
                    675: files that are nonexistent).  If the operation can be performed, what is
                    676: about to be done will be presented to the user for confirmation.  If the
                    677: user confirms the request, then phase two is executed, the action 
                    678: performed and reported to the user.
                    679: 
                    680:  Parameters:
                    681: 
                    682: =over 4
                    683: 
                    684: =item $r  - request object [in] - The Apache request being executed.
                    685: 
                    686: =item $fn = string [in] - The filename being manipulated by the 
                    687:                              request.
                    688: 
                    689: =item $uname - string [in] Name of user logged in and doing this action.
                    690: 
1.17      harris41  691: =item $udom  - string [in] Domain name under which the user logged in. 
1.12      foxr      692: 
                    693: =back
                    694: 
                    695: =cut
1.8       albertel  696: 
1.1       www       697: sub phaseone {
1.12      foxr      698:   my ($r,$fn,$uname,$udom)=@_;
                    699:   
1.36      www       700:   my $newfilename=&cleanDest($r,$ENV{'form.newfilename'});
                    701:   $newfilename=&relativeDest($fn,$newfilename,$uname);
1.23      albertel  702:   $r->print('<form action="/adm/cfile" method="post">'.
1.36      www       703:       '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
                    704:       '<input type="hidden" name="phase" value="two" />'.
                    705:       '<input type="hidden" name="action" value="'.$ENV{'form.action'}.'" />');
1.12      foxr      706:   
                    707:   if ($ENV{'form.action'} eq 'rename') {
1.36      www       708:       &Rename1($r, $uname, $udom, $fn, $newfilename);
1.12      foxr      709:   } elsif ($ENV{'form.action'} eq 'delete') { 
1.36      www       710:       &Delete1($r, $uname, $udom, $fn);
1.44      taceyjo1  711:   } elsif ($ENV{'form.action'} eq 'decompress') {
                    712:       &Decompress1($r, $uname, $udom, $fn);
1.12      foxr      713:   } elsif ($ENV{'form.action'} eq 'copy') { 
1.36      www       714:       if($newfilename) {
                    715: 	  &Copy1($r, $uname, $udom, $fn, $newfilename);
                    716:       } else {
1.47    ! sakharuk  717: 	  $r->print('<p>'.&mt('No new filename specified.').'</p></form>');
1.36      www       718:       }
1.12      foxr      719:   } elsif ($ENV{'form.action'} eq 'newdir') {
1.36      www       720:       &NewDir1($r, $uname, $udom, $fn, $newfilename);
1.22      albertel  721:   }  elsif ($ENV{'form.action'} eq 'newfile' ||
                    722: 	    $ENV{'form.action'} eq 'newhtmlfile' ||
1.28      www       723: 	    $ENV{'form.action'} eq 'newproblemfile' ||
                    724:             $ENV{'form.action'} eq 'newpagefile' ||
1.30      albertel  725:             $ENV{'form.action'} eq 'newsequencefile' ||
1.34      www       726:             $ENV{'form.action'} eq 'newrightsfile' ||
                    727:             $ENV{'form.action'} eq 'newstyfile' ||
1.30      albertel  728:             $ENV{'form.action'} eq 'Select Action') {
1.36      www       729:       if ($newfilename) {
                    730: 	  &NewFile1($r, $uname, $udom, $fn, $newfilename);
1.25      albertel  731:       } else {
1.47    ! sakharuk  732: 	  $r->print('<p>'.&mt('No new filename specified.').'</p></form>');
1.22      albertel  733:       }
1.12      foxr      734:   }
                    735: }
                    736: 
                    737: =pod
                    738: 
                    739: =item Rename2($request, $user, $directory, $oldfile, $newfile)
                    740: 
1.17      harris41  741: Performs phase 2 processing of a rename reequest.   This is where the
1.12      foxr      742: actual rename is performed.
                    743: 
                    744: Parameters
                    745: 
                    746: =over 4
                    747: 
                    748: =item $request - Apache request object [in] The request being processed.
                    749: 
                    750: =item $user  - string [in] The name of the user initiating the request.
                    751: 
                    752: =item $directory - string [in] The name of the directory relative to the
                    753:                  construction space top level of the renamed file.
                    754: 
                    755: =item $oldfile - Name of the file.
                    756: 
                    757: =item $newfile - Name of the new file.
                    758: 
                    759: =back
                    760: 
                    761: Returns:
                    762: 
                    763: =over 4
                    764: 
                    765: =item 1 Success.
                    766: 
                    767: =item 0 Failure.
                    768: 
                    769: =cut
                    770: 
                    771: sub Rename2 {
                    772: 
                    773:   my ($request, $user, $directory, $oldfile, $newfile) = @_;
                    774: 
                    775:   &Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile.
                    776: 	 " new file ".$newfile."\n");
                    777:   &Debug($request, "Target is: ".$directory.'/'.
                    778: 	 $newfile);
1.38      www       779:   if (-e $oldfile) {
1.40      www       780: 
                    781:       my $oRN=$oldfile;
                    782:       my $nRN=$newfile;
1.38      www       783:       unless (rename($oldfile,$newfile)) {
1.47    ! sakharuk  784: 	  $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
1.12      foxr      785: 	  return 0;
1.40      www       786:       }
                    787:       ## If old name.(extension) exits, move under new name.
                    788:       ## If it doesn't exist and a new.(extension) exists  
                    789:       ## delete it (only concern when renaming over files)
                    790:       my $tmp1=$oRN.'.meta';
                    791:       my $tmp2=$nRN.'.meta';
                    792:       if(-e $tmp1){
                    793: 	  unless(rename($tmp1,$tmp2)){ }
1.41      matthew   794:       } elsif(-e $tmp2){
1.40      www       795: 	  unlink $tmp2;
                    796:       }
                    797:       $tmp1=$oRN.'.save';
                    798:       $tmp2=$nRN.'.save';
                    799:       if(-e $tmp1){
                    800: 	  unless(rename($tmp1,$tmp2)){ }
1.41      matthew   801:       } elsif(-e $tmp2){
1.40      www       802: 	  unlink $tmp2;
                    803:       }
                    804:       $tmp1=$oRN.'.log';
                    805:       $tmp2=$nRN.'.log';
                    806:       if(-e $tmp1){
                    807: 	  unless(rename($tmp1,$tmp2)){ }
1.41      matthew   808:       } elsif(-e $tmp2){
1.40      www       809: 	  unlink $tmp2;
                    810:       }
                    811:       $tmp1=$oRN.'.bak';
                    812:       $tmp2=$nRN.'.bak';
                    813:       if(-e $tmp1){
                    814: 	  unless(rename($tmp1,$tmp2)){ }
1.41      matthew   815:       } elsif(-e $tmp2){
1.40      www       816: 	  unlink $tmp2;
1.38      www       817:       }
1.12      foxr      818:   } else {
1.47    ! sakharuk  819:       $request->print("<p> ".&mt('No such file').": ".&display($oldfile).'</p></form>');
1.12      foxr      820:       return 0;
                    821:   }
                    822:   return 1;
                    823: }
                    824: =pod
                    825: 
                    826: =item Delete2($request, $user, $filename)
                    827: 
                    828:   Performs phase two of a delete.  The user has confirmed that they want 
                    829: to delete the selected file.   The file is deleted and the results of the
                    830: delete attempt are indicated.
                    831: 
                    832: Parameters:
                    833: 
                    834: =over 4
                    835: 
                    836: =item $request - Apache Request object [in] the request object for the current
                    837:                  delete operation.
                    838: 
                    839: =item $user    - string [in]  The name of the user initiating the delete
                    840:                  request.
                    841: 
1.17      harris41  842: =item $filename - string [in] The name of the file, relative to construction
                    843:                   space, to delete.
1.12      foxr      844: 
                    845: =back
                    846: 
                    847: Returns:
                    848:   1 - success.
                    849:   0 - Failure.
                    850: 
                    851: =cut
                    852: 
                    853: sub Delete2 {
                    854:   my ($request, $user, $filename) = @_;
1.46      taceyjo1  855:   if(opendir DIR, $filename) { 
                    856:     my @files=readdir(DIR);
                    857:     shift @files; shift @files; # takes off . and ..
                    858:     if(@files) { 
1.47    ! sakharuk  859:       $request->print('<font color="red"> '.&mt('Error: Directory Non Empty').'</font>'); 
1.46      taceyjo1  860:       return 0;
                    861:     }
                    862:     else {   
                    863:       if(-e $filename) {
                    864:         unless(rmdir($filename)) {
1.47    ! sakharuk  865:           $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
1.46      taceyjo1  866:           return 0;
                    867:         }
                    868:       }
                    869:       else {
1.47    ! sakharuk  870:         $request->print('<p> '.&mt('No such file').'. </p></form');
1.46      taceyjo1  871:         return 0;
                    872:       }
1.12      foxr      873: 
1.46      taceyjo1  874:      }
                    875: 
                    876:    }
                    877:   else {
                    878:     if(-e $filename) {
                    879:       unless(unlink($filename)) {
1.47    ! sakharuk  880:         $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
1.46      taceyjo1  881:         return 0;
                    882:       }
                    883:     }
                    884:     else {
1.47    ! sakharuk  885:       $request->print('<p> '.&mt('No such file').'. </p></form');
1.12      foxr      886:       return 0;
                    887:   }
1.46      taceyjo1  888: 	}
1.12      foxr      889:   return 1;
                    890: }
                    891: 
                    892: =pod
                    893: 
                    894: =item Copy2($request, $username, $dir, $oldfile, $newfile)
                    895: 
                    896:    Performs phase 2 of a copy.  The file is copied and the status 
                    897:    of that copy is reported back to the user.
                    898: 
                    899: =over 4
                    900: 
                    901: =item $request - Apache request object [in]; the apache request currently
                    902:                  being executed.
                    903: 
                    904: =item $username - string [in] Name of the user who is requesting the copy.
                    905: 
                    906: =item $dir - string [in] Directory path relative to the construction space
                    907:              of the destination file.
                    908: 
                    909: =item $oldfile - string [in] Name of the source file.
                    910: 
                    911: =item $newfile - string [in] Name of the destination file.
                    912: 
                    913: 
                    914: =back
                    915: 
                    916: Returns 0 failure, and 0 successs.
                    917: 
                    918: =cut
1.1       www       919: 
1.12      foxr      920: sub Copy2 {
                    921:     my ($request, $username, $dir, $oldfile, $newfile) = @_;
                    922:     &Debug($request ,"Will try to copy $oldfile to $newfile");
                    923:     if(-e $oldfile) {
                    924: 	unless (copy($oldfile, $newfile)) {
1.47    ! sakharuk  925: 	    $request->print('<font color="red"> '.&mt('copy Error').': '.$!.'</font>');
1.12      foxr      926: 	    return 0;
                    927: 	} else {
1.14      foxr      928: 	    unless (chmod(0660, $newfile)) {
1.47    ! sakharuk  929: 		$request->print('<font color="red"> '.&mt('chmod error').': '.$!.'</font>');
1.14      foxr      930: 		return 0;
                    931: 	    }
1.12      foxr      932: 	    return 1;
                    933: 	}
1.11      albertel  934:     } else {
1.47    ! sakharuk  935: 	$request->print('<p> '.&mt('No such file').' </p>');
1.12      foxr      936: 	return 0;
1.11      albertel  937:     }
1.12      foxr      938:     return 1;
                    939: }
                    940: =pod
                    941: 
                    942: =item NewDir2($request, $user, $newdirectory)
1.1       www       943: 
1.12      foxr      944: 	Performs phase 2 processing of directory creation.  This involves creating the directory and
                    945: 	reporting the results of that creation to the user.
                    946: 	
                    947: Parameters:
                    948: =over 4
                    949: 
                    950: =item $request  - Apache request object [in].  Object representing the current HTTP request.
                    951: 
                    952: =item $user - string [in] The name of the user that is initiating the request.
                    953: 
                    954: =item $newdirectory - string [in] The full path of the directory being created.
                    955: 
                    956: =back
                    957: 
                    958: Returns 0 - failure 1 - success.
                    959: 
                    960: =cut
1.8       albertel  961: 
1.12      foxr      962: sub NewDir2 {
                    963:   my ($request, $user, $newdirectory) = @_;
                    964:   
                    965:   unless(mkdir($newdirectory, 02770)) {
1.47    ! sakharuk  966:     $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
1.12      foxr      967:     return 0;
                    968:   }
                    969:   unless(chmod(02770, ($newdirectory))) {
1.47    ! sakharuk  970:       $request->print('<font color="red"> '.&mt('Error').': '.$!.'</font>');
1.12      foxr      971:       return 0;
                    972:   }
                    973:   return 1;
1.1       www       974: }
1.44      taceyjo1  975: sub decompress2 {
                    976: 	my ($r, $user, $dir, $file) = @_;
                    977: 	&Apache::lonnet::appenv('cgi.file' => $file);
                    978: 	&Apache::lonnet::appenv('cgi.dir' => $dir);
                    979: 	my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                    980: 	$r->print($result);
                    981: 	&Apache::lonnet::delenv('cgi.file');
                    982: 	&Apache::lonnet::delenv('cgi.dir');
                    983: 	return 1;
                    984: }
1.12      foxr      985: =pod
                    986: 
                    987: =item phasetwo($r, $fn, $uname, $udom)
                    988: 
                    989:    Controls the phase 2 processing of file management
                    990:    requests for construction space.  In phase one, the user
                    991:    was asked to confirm the operation.  In phase 2, the operation
                    992:    is performed and the result is shown.
                    993: 
                    994:   The strategy is to break out the processing into specific action processors
                    995:   named action2 where action is the requested action and the 2 denotes 
                    996:   phase 2 processing.
                    997: 
                    998: Parameters:
                    999: 
                   1000: =over 4
                   1001: 
                   1002: =item  $r     - Apache Request object [in] The request object for this httpd
                   1003:            transaction.
                   1004: 
                   1005: =item  $fn    - string [in]  A filename indicating the object that is being
                   1006:            manipulated.
                   1007: 
                   1008: =item  $uname - string [in] The name of the user initiating the file management
                   1009:            request.
                   1010: 
                   1011: =item  $udom  - string  [in] The login domain of the user initiating the
                   1012:            file management request.
                   1013: =back
                   1014: 
                   1015: =cut
                   1016: 
1.1       www      1017: sub phasetwo {
                   1018:     my ($r,$fn,$uname,$udom)=@_;
1.12      foxr     1019:     
1.9       foxr     1020:     &Debug($r, "loncfile - Entering phase 2 for $fn");
1.12      foxr     1021:     
                   1022:     # Break down the file into it's component pieces.
                   1023:     
1.27      albertel 1024:     my $dir;		# Directory path
                   1025:     my $main;		# Filename.
                   1026:     my $suffix;		# Extension.
1.46      taceyjo1 1027:     if ($fn=~m:(.*)/([^/]+):) {
1.27      albertel 1028: 	$dir=$1;		# Directory path
                   1029: 	$main=$2;		# Filename.
1.46      taceyjo1 1030: 	}
                   1031: 	if($main=~m:\.(\w+)$:){ # Fixes problems with filenames with no extensions
                   1032: 		$main=$`;
                   1033: 		$suffix=$1;
                   1034: 	}
1.12      foxr     1035:     my $dest;                   # On success this is where we'll go.
1.9       foxr     1036:     
1.12      foxr     1037:     &Debug($r, 
                   1038: 	   "loncfile::phase2 dir = $dir main = $main suffix = $suffix");
                   1039:     &Debug($r,
                   1040: 	   "    newfilename = ".$ENV{'form.newfilename'});
1.9       foxr     1041: 
                   1042:     my $conspace=$fn;
1.12      foxr     1043:     
                   1044:     &Debug($r, 
                   1045: 	   "loncfile::phase2 Full construction space name: $conspace");
                   1046:     
                   1047:     &Debug($r, 
                   1048: 	   "loncfie::phase2 action is $ENV{'form.action'}");
                   1049:     
                   1050:     # Select the appropriate processing sub.
1.44      taceyjo1 1051:     if ($ENV{'form.action'} eq 'decompress') { 
                   1052: 	$main .= '.';
                   1053: 	$main .= $suffix;
                   1054: 	    if(!&decompress2($r, $uname, $dir, $main)) {
                   1055: 		return ;
                   1056: 		}
                   1057: 	    $dest = $dir."/.";
                   1058:      
                   1059: 	
                   1060:     } elsif ($ENV{'form.action'} eq 'rename') { # Rename.
1.12      foxr     1061: 	if($ENV{'form.newfilename'}) {
1.27      albertel 1062: 	    if (!defined($dir)) {
                   1063: 		$fn=~m:^(.*)/:;
                   1064: 		$dir=$1;
                   1065: 	    }
1.12      foxr     1066: 	    if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
                   1067: 		return;
                   1068: 	    }
1.38      www      1069: 	    $dest = &url($ENV{'form.newfilename'});
1.12      foxr     1070: 	}
1.5       www      1071:     } elsif ($ENV{'form.action'} eq 'delete') { 
1.12      foxr     1072: 	if(!&Delete2($r, $uname, $ENV{'form.newfilename'})) {
                   1073: 	    return ;
                   1074: 	}
                   1075: 	# Once a resource is deleted, we just list the directory that
                   1076: 	# previously held it.
                   1077: 	#
1.20      albertel 1078: 	$dest = $dir."/.";		# Parent dir.
1.5       www      1079:     } elsif ($ENV{'form.action'} eq 'copy') { 
1.12      foxr     1080: 	if($ENV{'form.newfilename'}) {
                   1081: 	    if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
1.44      taceyjo1 1082: 		return ;
1.12      foxr     1083: 		}
                   1084: 	    $dest = $ENV{'form.newfilename'};
                   1085:      
                   1086: 	} else {
1.47    ! sakharuk 1087: 	    $r->print('<p>'.&mt('No New filename specified').'</p></form>');
1.12      foxr     1088: 	    return;
                   1089: 	}
                   1090: 	
1.5       www      1091:     } elsif ($ENV{'form.action'} eq 'newdir') {
1.38      www      1092:         my $newdir= $ENV{'form.newfilename'};
1.12      foxr     1093: 	if(!&NewDir2($r, $uname, $newdir)) {
                   1094: 	    return;
                   1095: 	}
                   1096: 	$dest = $newdir."/"
                   1097:     }
1.47    ! sakharuk 1098:     $r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>');
1.1       www      1099: }
                   1100: 
                   1101: sub handler {
                   1102: 
1.10      foxr     1103:   $r=shift;
1.1       www      1104: 
1.9       foxr     1105: 
                   1106:   &Debug($r, "loncfile.pm - handler entered");
1.12      foxr     1107:   &Debug($r, " filename: ".$ENV{'form.filename'});
                   1108:   &Debug($r, " newfilename: ".$ENV{'form.newfilename'});
1.36      www      1109: #
                   1110: # Determine the root filename
                   1111: # This could come in as "filename", which actually is a URL, or
                   1112: # as "qualifiedfilename", which is indeed a real filename in filesystem
                   1113: #
1.1       www      1114:   my $fn;
                   1115: 
                   1116:   if ($ENV{'form.filename'}) {
1.44      taceyjo1 1117: 	
                   1118: 	&Debug($r, "test: $ENV{'form.filename'}");
1.22      albertel 1119:       $fn=&Apache::lonnet::unescape($ENV{'form.filename'});
1.35      www      1120:       $fn=&URLToPath($fn);
1.44      taceyjo1 1121:   }  
1.45      taceyjo1 1122: 	#Just hijack the script only the first time around to inject the correct information for further processing
1.44      taceyjo1 1123:     elsif($ENV{'QUERY_STRING'} && $ENV{'form.phase'} ne 'two') {
                   1124: 	  &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress']);
                   1125: 	 $fn=&Apache::lonnet::unescape($ENV{'form.decompress'});
                   1126: 	$fn=&URLToPath($fn);
                   1127: 	$ENV{'form.action'}="decompress";
                   1128:   }
                   1129: 
                   1130:     elsif ($ENV{'form.qualifiedfilename'}) {
1.36      www      1131:       $fn=$ENV{'form.qualifiedfilename'};
1.1       www      1132:   } else {
1.9       foxr     1133:       &Debug($r, "loncfile::handler - no form.filename");
1.1       www      1134:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
                   1135:          ' unspecified filename for cfile', $r->filename); 
                   1136:      return HTTP_NOT_FOUND;
                   1137:   }
                   1138: 
                   1139:   unless ($fn) { 
1.9       foxr     1140:       &Debug($r, "loncfile::handler - doctored url is empty");
1.1       www      1141:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
                   1142:          ' trying to cfile non-existing file', $r->filename); 
                   1143:      return HTTP_NOT_FOUND;
                   1144:   } 
                   1145: 
                   1146: # ----------------------------------------------------------- Start page output
                   1147:   my $uname;
                   1148:   my $udom;
                   1149: 
                   1150:   ($uname,$udom)=
                   1151:     &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
1.9       foxr     1152:   &Debug($r, 
                   1153: 	 "loncfile::handler constructaccess uname = $uname domain = $udom");
1.1       www      1154:   unless (($uname) && ($udom)) {
                   1155:      $r->log_reason($uname.' at '.$udom.
1.4       www      1156:          ' trying to manipulate file '.$ENV{'form.filename'}.
1.1       www      1157:          ' ('.$fn.') - not authorized', 
                   1158:          $r->filename); 
                   1159:      return HTTP_NOT_ACCEPTABLE;
                   1160:   }
                   1161: 
                   1162: 
                   1163:   $r->content_type('text/html');
                   1164:   $r->send_http_header;
                   1165: 
                   1166:   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
                   1167: 
1.36      www      1168:   $r->print(&Apache::loncommon::bodytag('Construction Space File Operation'));
1.1       www      1169: 
                   1170:   
1.47    ! sakharuk 1171:   $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
1.1       www      1172:   
                   1173:   if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
1.47    ! sakharuk 1174:           $r->print('<h3><font color="red">'.&mt('Co-Author').': '.$uname.' at '.$udom.
1.1       www      1175:                '</font></h3>');
                   1176:   }
                   1177: 
1.9       foxr     1178: 
                   1179:   &Debug($r, "loncfile::handler Form action is $ENV{'form.action'} ");
1.2       www      1180:   if ($ENV{'form.action'} eq 'delete') {
1.9       foxr     1181:       
1.47    ! sakharuk 1182:       $r->print('<h3>'.&mt('Delete').'</h3>');
1.2       www      1183:   } elsif ($ENV{'form.action'} eq 'rename') {
1.47    ! sakharuk 1184:       $r->print('<h3>'.&mt('Rename').'</h3>');
1.2       www      1185:   } elsif ($ENV{'form.action'} eq 'newdir') {
1.47    ! sakharuk 1186:       $r->print('<h3>'.&mt('New Directory').'</h3>');
1.44      taceyjo1 1187:   } elsif ($ENV{'form.action'} eq 'decompress') {
1.47    ! sakharuk 1188:       $r->print('<h3>'.&mt('Decompress').'</h3>');
1.2       www      1189:   } elsif ($ENV{'form.action'} eq 'copy') {
1.47    ! sakharuk 1190:       $r->print('<h3>'.&mt('Copy').'</h3>');
1.22      albertel 1191:   } elsif ($ENV{'form.action'} eq 'newfile' ||
                   1192: 	   $ENV{'form.action'} eq 'newhtmlfile' ||
1.28      www      1193: 	   $ENV{'form.action'} eq 'newproblemfile' ||
                   1194:            $ENV{'form.action'} eq 'newpagefile' ||
1.30      albertel 1195:            $ENV{'form.action'} eq 'newsequencefile' ||
1.34      www      1196: 	   $ENV{'form.action'} eq 'newrightsfile' ||
                   1197: 	   $ENV{'form.action'} eq 'newstyfile' ||
1.30      albertel 1198:            $ENV{'form.action'} eq 'Select Action' ) {
1.47    ! sakharuk 1199:       $r->print('<h3>'.&mt('New Resource').'</h3>');
1.2       www      1200:   } else {
1.47    ! sakharuk 1201:      $r->print('<p>'.&mt('Unknown Action').' '.$ENV{'form.action'}.' </p></body></html>');
1.2       www      1202:      return OK;  
                   1203:   }
1.1       www      1204:   if ($ENV{'form.phase'} eq 'two') {
1.9       foxr     1205:       &Debug($r, "loncfile::handler  entering phase2");
1.4       www      1206:       &phasetwo($r,$fn,$uname,$udom);
1.1       www      1207:   } else {
1.9       foxr     1208:       &Debug($r, "loncfile::handler  entering phase1");
1.3       www      1209:       &phaseone($r,$fn,$uname,$udom);
1.1       www      1210:   }
                   1211: 
                   1212:   $r->print('</body></html>');
                   1213:   return OK;  
                   1214: }
                   1215: 
                   1216: 1;
                   1217: __END__
1.9       foxr     1218: 

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