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

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

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