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

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

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