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

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

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