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

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

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