File:  [LON-CAPA] / loncom / publisher / loncfile.pm
Revision 1.96: download - view: text, annotated - select for diffs
Mon Apr 13 21:29:26 2009 UTC (15 years, 1 month ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- Additional extensions allowed for new files created in Construction Space:
js css txt

    1: # The LearningOnline Network with CAPA
    2: # Handler to rename files, etc, in construction space
    3: #
    4: #  This file responds to the various buttons and events
    5: #  in the top frame of the construction space directory.
    6: #  Each event is processed in two phases.  The first phase
    7: #  presents a page that describes the proposed action to the user
    8: #  and requests confirmation.  The second phase commits the action
    9: #  and displays a page showing the results of the action.
   10: #
   11: #
   12: # $Id: loncfile.pm,v 1.96 2009/04/13 21:29:26 raeburn Exp $
   13: #
   14: # Copyright Michigan State University Board of Trustees
   15: #
   16: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   17: #
   18: # LON-CAPA is free software; you can redistribute it and/or modify
   19: # it under the terms of the GNU General Public License as published by
   20: # the Free Software Foundation; either version 2 of the License, or
   21: # (at your option) any later version.
   22: #
   23: # LON-CAPA is distributed in the hope that it will be useful,
   24: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   25: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   26: # GNU General Public License for more details.
   27: #
   28: # You should have received a copy of the GNU General Public License
   29: # along with LON-CAPA; if not, write to the Free Software
   30: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   31: #
   32: # /home/httpd/html/adm/gpl.txt
   33: #
   34: # http://www.lon-capa.org/
   35: #
   36: =pod
   37: 
   38: =head1 NAME
   39: 
   40: Apache::loncfile - Construction space file management.
   41: 
   42: =head1 SYNOPSIS
   43:  
   44:  Content handler for buttons on the top frame of the construction space 
   45: directory.
   46: 
   47: =head1 INTRODUCTION
   48: 
   49:   loncfile is invoked when buttons in the top frame of the construction 
   50: space directory listing are clicked.   All operations proceed in two phases.
   51: The first phase describes to the user exactly what will be done.  If the user
   52: confirms the operation, the second phase commits the operation and indicates
   53: completion.  When the user dismisses the output of phase2, they are returned to
   54: an "appropriate" directory listing in general.
   55: 
   56:     This is part of the LearningOnline Network with CAPA project
   57: described at http://www.lon-capa.org.
   58: 
   59: =head2 Subroutines
   60: 
   61: =cut
   62: 
   63: package Apache::loncfile;
   64: 
   65: use strict;
   66: use Apache::File;
   67: use File::Basename;
   68: use File::Copy;
   69: use HTML::Entities();
   70: use Apache::Constants qw(:common :http :methods);
   71: use Apache::loncacc;
   72: use Apache::lonnet;
   73: use Apache::loncommon();
   74: use Apache::lonlocal;
   75: use LONCAPA qw(:DEFAULT :match);
   76: 
   77: 
   78: my $DEBUG=0;
   79: my $r;				# Needs to be global for some stuff RF.
   80: 
   81: =pod
   82: 
   83: =item Debug($request, $message)
   84: 
   85:   If debugging is enabled puts out a debugging message determined by the
   86:   caller.  The debug message goes to the Apache error log file. Debugging
   87:   is enabled by setting the module global DEBUG variable to nonzero (TRUE).
   88: 
   89:  Parameters:
   90: 
   91: =over 4
   92:  
   93: =item $request - The current request operation.
   94: 
   95: =item $message - The message to put in the log file.
   96: 
   97: =back
   98:   
   99:  Returns:
  100:    nothing.
  101: 
  102: =cut
  103: 
  104: sub Debug {
  105:     # Put out the indicated message butonly if DEBUG is true.
  106:     if ($DEBUG) {
  107: 	my ($r,$message) = @_;
  108: 	$r->log_reason($message);
  109:     }
  110: }
  111: 
  112: sub done {
  113:    my ($url)=@_;
  114:    my $done=&mt("Done");
  115:    return(<<ENDDONE);
  116: <a href="$url">$done</a>
  117: <script type="text/javascript">
  118: location.href="$url";
  119: </script>
  120: ENDDONE
  121: }
  122: 
  123: =pod
  124: 
  125: =item URLToPath($url)
  126: 
  127:   Convert a URL to a file system path.
  128:   
  129:   In order to manipulate the construction space objects, it is necessary
  130:   to access url identified objects a filespace objects.  This function
  131:   translates a construction space URL to a file system path.
  132:  Parameters:
  133: 
  134: =over 4
  135: 
  136: =item  Url    - string [in] The url to convert.
  137:   
  138: =back
  139:   
  140:  Returns:
  141: 
  142: =over 4
  143: 
  144: =item  The corresponding file system path. 
  145: 
  146: =back
  147: 
  148: Global References
  149: 
  150: =over 4
  151: 
  152: =item  $r      - Request object [in] Referenced in the &Debug calls.
  153: 
  154: =back
  155: 
  156: =cut
  157: 
  158: sub URLToPath {
  159:     my $Url = shift;
  160:     &Debug($r, "UrlToPath got: $Url");
  161:     $Url=~ s/\/+/\//g;
  162:     $Url=~ s/^https?\:\/\/[^\/]+//;
  163:     $Url=~ s/^\///;
  164:     $Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//;
  165:     &Debug($r, "Returning $Url \n");
  166:     return $Url;
  167: }
  168: 
  169: sub url {
  170:     my $fn=shift;
  171:     $fn=~s/^\/home\/($match_username)\/public\_html/\/priv\/$1/;
  172:     $fn=&HTML::Entities::encode($fn,'<>"&');
  173:     return $fn;
  174: }
  175: 
  176: sub display {
  177:     my $fn=shift;
  178:     $fn=~s-^/home/($match_username)/public_html-/priv/$1-;
  179:     return '<span class="LC_filename">'.$fn.'</span>';
  180: }
  181: 
  182: 
  183: # see if the file is
  184: # a) published (return 0 if not)
  185: # b) if, so obsolete (return 0 if not)
  186: 
  187: sub obsolete_unpub {
  188:     my ($user,$domain,$construct)=@_;
  189:     my $published=$construct;
  190:     $published=~
  191: 	s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;
  192:     if (-e $published) {
  193: 	if (&Apache::lonnet::metadata($published,'obsolete')) {
  194: 	    return 1;
  195: 	}
  196: 	return 0;
  197:     } else {
  198: 	return 1;
  199:     }
  200: }
  201: 
  202: # see if directory is empty
  203: # ignores any .meta, .save, .bak, and .log files created for a previously
  204: # published file, which has since been marked obsolete and deleted.
  205: sub empty_directory {
  206:     my ($dirname,$phase) = @_;
  207:     if (opendir DIR, $dirname) {
  208:         my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and ..
  209:         if (@files) { 
  210:             my @orphans = grep(/\.(meta|save|log|bak)$/,@files);
  211:             if (scalar(@files) - scalar(@orphans) > 0) { 
  212:                 return 0;
  213:             } else {
  214:                 if (($phase eq 'Delete2') && (@orphans > 0)) {
  215:                     foreach my $file (@orphans) {
  216:                         if ($file =~ /\.(meta|save|log|bak)$/) {
  217:                             unlink($dirname.$file);
  218:                         }
  219:                     }
  220:                 }
  221:             }
  222:         }
  223:         closedir(DIR);
  224:         return 1;
  225:     }
  226:     return 0;
  227: }
  228: 
  229: =pod
  230: 
  231: =item exists($user, $domain, $file)
  232: 
  233:    Determine if a resource file name has been published or exists
  234:    in the construction space.
  235: 
  236:  Parameters:
  237: 
  238: =over 4
  239: 
  240: =item  $user     - string [in] - Name of the user for which to check.
  241: 
  242: =item  $domain   - string [in] - Name of the domain in which the resource
  243:                           might have been published.
  244: 
  245: =item  $file     - string [in] - Name of the file.
  246: 
  247: =item  $creating - string [in] - optional, type of object being created,
  248:                                either 'directory' or 'file'. Defaults to
  249:                                'file' if unspecified.
  250: 
  251: =back
  252: 
  253: Returns:
  254: 
  255: =over 4
  256: 
  257: =item  string - Either undef, 'warning' or 'error' depending on the
  258:                 type of problem
  259: 
  260: =item  string - Either where the resource exists as an html string that can
  261:            be embedded in a dialog or an empty string if the resource
  262:            does not exist.
  263:   
  264: =back
  265: 
  266: =cut
  267: 
  268: sub exists {
  269:     my ($user, $domain, $construct, $creating) = @_;
  270:     $creating ||= 'file';
  271: 
  272:     my $published=$construct;
  273:     $published=~
  274: 	s{^/home/$user/public_html/}{/home/httpd/html/res/$domain/$user/};
  275:     my ($type,$result);
  276:     if ( -d $construct ) {
  277: 	return ('error','<p><span class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</span></p>');
  278: 	
  279:     }
  280: 
  281:     if ( -e $published) {
  282: 	if ( -e $construct ) {
  283: 	    $type = 'warning';
  284: 	    $result.='<p><span class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</span></p>';
  285: 	} else {
  286: 	    my $published_type = (-d $published) ? 'directory' : 'file';
  287: 
  288: 	    if ($published_type eq $creating) {
  289: 		$type = 'warning';
  290: 		$result.='<p><span class="LC_warning">'.&mt("Warning: a published $published_type of this name exists.").'</span></p>';
  291: 	    } else {
  292: 		$type = 'error';
  293: 		$result.='<p><span class="LC_error">'.&mt("Error: a published $published_type of this name exists.").'</span></p>';
  294: 	    }
  295: 	}
  296:     } elsif ( -e $construct) {
  297: 	$type = 'warning';
  298: 	$result.='<p><span class="LC_warning">'.&mt('Warning: target file exists!').'</span></p>';
  299:     }
  300: 
  301:     return ($type,$result);
  302: }
  303: 
  304: =pod
  305: 
  306: =item checksuffix($old, $new)
  307:         
  308:   Determine if a resource filename suffix (the stuff after the .) would change
  309: as a result of this operation.
  310: 
  311:  Parameters:
  312: 
  313: =over 4
  314: 
  315: =item  $old   = string [in]  Previous filename.
  316: 
  317: =item  $new   = string [in]  Resultant filename.
  318: 
  319: =back
  320: 
  321:  Returns:
  322: 
  323: =over 4
  324: 
  325: =item    Empty string if everything worked.
  326: 
  327: =item    String containing an error message if there was a problem.
  328: 
  329: =back
  330: 
  331: =cut
  332: 
  333: sub checksuffix {
  334:     my ($old,$new) = @_;
  335:     my $result;
  336:     my $oldsuffix;
  337:     my $newsuffix;
  338:     if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }
  339:     if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
  340:     if (lc($oldsuffix) ne lc($newsuffix)) {
  341: 	$result.=
  342:             '<p><span class="LC_warning">'.&mt('Warning: change of MIME type!').'</span></p>';
  343:     }
  344:     return $result;
  345: }
  346: 
  347: sub cleanDest {
  348:     my ($request,$dest,$subdir,$fn,$uname)=@_;
  349:     #remove bad characters
  350:     my $foundbad=0;
  351:     if ($subdir && $dest =~/\./) {
  352: 	$foundbad=1;
  353: 	$dest=~s/\.//g;
  354:     }
  355:     $dest =~ s/(\s+$|^\s+)//g;
  356:     if  ($dest=~/[\#\?&%\":]/) {
  357: 	$foundbad=1;
  358: 	$dest=~s/[\#\?&%\":]//g;
  359:     }
  360:     if ($dest=~m|/|) {
  361: 	my ($newpath)=($dest=~m|(.*)/|);
  362: 	$newpath=&relativeDest($fn,$newpath,$uname);
  363: 	if (! -d "$newpath") {
  364: 	    $request->print('<p><span class="LC_error">'
  365:                            .&mt("You have requested to create file in directory [_1] which doesn't exist. The requested directory path has been removed from the requested file name."
  366:                                ,'"'.&display($newpath).'"')
  367:                            .'</span></p>');
  368: 	    $dest=~s|.*/||;
  369: 	}
  370:     }
  371:     if ($dest =~ /\.(\d+)\.(\w+)$/){
  372: 	$request->print('<span class="LC_error">'
  373: 			.&mt('Bad filename [_1]','<span class="LC_filename">'.&display($dest).'</span>')
  374:                         .'<br />'
  375:                         .&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>')
  376:                         .'<br />'
  377:                         .&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>')
  378: 			.'</span>');
  379: 	$dest =~ s/\.(\d+)(\.\w+)$/$2/;
  380:     }
  381:     if ($foundbad) {
  382: 	$request->print("<p><span class=\"LC_error\">".&mt('Invalid characters in requested name have been removed.')."</span></p>");
  383:     }
  384:     return $dest;
  385: }
  386: 
  387: sub relativeDest {
  388:     my ($fn,$newfilename,$uname)=@_;
  389:     if ($newfilename=~/^\//) {
  390: # absolute, simply add path
  391: 	$newfilename='/home/'.$uname.'/public_html/';
  392:     } else {
  393: 	my $dir=$fn;
  394: 	$dir=~s/\/[^\/]+$//;
  395: 	$newfilename=$dir.'/'.$newfilename;
  396:     }
  397:     $newfilename=~s://+:/:g; # remove duplicate /
  398:     while ($newfilename=~m:/\.\./:) {
  399: 	$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
  400:     }
  401:     return $newfilename;
  402: }
  403: 
  404: =pod
  405: 
  406: =item CloseForm1($request, $user, $file)
  407: 
  408:    Close of a form on the successful completion of phase 1 processing
  409: 
  410: Parameters:
  411: 
  412: =over 4
  413: 
  414: =item  $request - Apache Request Object [in] - Apache server request object.
  415: 
  416: =item  $cancelurl - the url to go to on cancel.
  417: 
  418: =back
  419: 
  420: =cut
  421: 
  422: sub CloseForm1 {
  423:     my ($request,  $fn) = @_;
  424:     $request->print('<p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
  425:     $request->print('<form action="'.&url($fn).
  426: 		    '" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
  427: }
  428: 
  429: 
  430: =pod
  431: 
  432: =item CloseForm2($request, $user, $directory)
  433: 
  434:    Successfully close off the phase 2 form.
  435: 
  436: Parameters:
  437: 
  438: =over 4
  439: 
  440: =item   $request    - Apache Request object [in] - The request that is being
  441:                  executed.
  442: 
  443: =item   $user       - string [in] - Name of the user that is initiating the
  444:                  request.
  445: 
  446: =item   $directory  - string [in] - Directory in which the operation is 
  447:                  being done relative to the top level construction space
  448:                  directory.
  449: 
  450: =back
  451: 
  452: =cut
  453: 
  454: sub CloseForm2 {
  455:     my ($request, $user, $fn) = @_;
  456:     $request->print(&done(&url($fn)));
  457: }
  458: 
  459: =pod
  460: 
  461: =item Rename1($request, $filename, $user, $domain, $dir)
  462:  
  463:    Perform phase 1 processing of the file rename operation.
  464: 
  465: Parameters:
  466: 
  467: =over 4
  468: 
  469: =item  $request   - Apache Request Object [in] The request object for the 
  470: current request.
  471: 
  472: =item  $filename  - The filename relative to construction space.
  473: 
  474: =item  $user      - Name of the user making the request.
  475: 
  476: =item  $domain    - User login domain.
  477: 
  478: =item  $dir       - Directory specification of the path to the file.
  479: 
  480: =back
  481: 
  482: Side effects:
  483: 
  484: =over 4
  485: 
  486: =item A new form is displayed prompting for confirmation.  The newfilename
  487: hidden field of this form is loaded with
  488: new filename relative to the current directory ($dir).
  489: 
  490: =back
  491: 
  492: =cut  
  493: 
  494: sub Rename1 {
  495:     my ($request, $user, $domain, $fn, $newfilename, $style) = @_;
  496: 
  497:     if(-e $fn) {
  498: 	if($newfilename) {
  499: 	    # is dest a dir
  500: 	    if ($style eq 'move') {
  501: 		if (-d $newfilename) {
  502: 		    if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; }
  503: 		}
  504: 	    }
  505: 	    if ($newfilename =~ m|/[^\.]+$|) {
  506: 		#no extension add on original extension
  507: 		if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {
  508: 		    $newfilename.='.'.$1;
  509: 		}
  510: 	    }
  511: 	    $request->print(&checksuffix($fn, $newfilename));
  512: 	    #renaming a dir, delete the trailing /
  513:             #remove second to last element for current dir
  514: 	    if (-d $fn) {
  515: 		$newfilename=~/\.(\w+)$/;
  516: 		if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {
  517: 		    $request->print('<br /><span classr="LC_warning">'.
  518: 				    &mt('Cannot change MIME type of a directory').
  519: 				    '</span>'.
  520: 				    '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
  521: 		    return;
  522: 		}
  523: 		$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;
  524: 	    }
  525: 	    $newfilename=~s://+:/:g; # remove duplicate /
  526: 	    while ($newfilename=~m:/\.\./:) {
  527: 		$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
  528: 	    }
  529: 	    my ($type, $return)=&exists($user, $domain, $newfilename);
  530: 	    $request->print($return);
  531: 	    if ($type eq 'error') {
  532: 		$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
  533: 		return;
  534: 	    }
  535: 	    unless (&obsolete_unpub($user,$domain,$fn)) {
  536: 		$request->print('<h3>'.&mt('Cannot rename or move non-obsolete published file').'</h3>'.
  537: 				'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
  538: 		return;
  539: 	    }
  540: 	    my $action;
  541: 	    if ($style eq 'rename') {
  542: 		$action=&mt('Rename');
  543: 	    } else {
  544: 		$action=&mt('Move');
  545: 	    }
  546: 	    $request->print('<input type="hidden" name="newfilename" value="'.
  547: 			    $newfilename.
  548: 			    '" /><p>'.$action.' '.&display($fn).
  549: 			    '</p><br />to '.&display($newfilename).'?</p>');
  550: 	    &CloseForm1($request, $fn);
  551: 	} else {
  552: 	    $request->print('<p>'.&mt('No new filename specified.').'</p></form>');
  553: 	    return;
  554: 	}
  555:     } else {
  556: 	$request->print('<p> '.&mt('No such file').': '.&display($fn).'</p></form>');
  557: 	return;
  558:     }
  559:     
  560: }
  561: 
  562: =pod
  563: 
  564: =item Delete1
  565: 
  566:    Performs phase 1 processing of the delete operation.  In phase one
  567:   we just check to be sure the file exists.
  568: 
  569: Parameters:
  570: 
  571: =over 4
  572: 
  573: =item   $request   - Apache Request Object [in] request object for the current 
  574:                 request.
  575: 
  576: =item   $user      - string [in]  Name of the user initiating the request.
  577: 
  578: =item   $domain    - string [in]  Domain the initiating user is logged in as
  579: 
  580: =item   $filename  - string [in]  Source filename.
  581: 
  582: =back
  583: 
  584: =cut
  585: 
  586: sub Delete1 {
  587:     my ($request, $user, $domain, $fn) = @_;
  588: 
  589:     if( -e $fn) {
  590: 	$request->print('<input type="hidden" name="newfilename" value="'.
  591: 			$fn.'" />');
  592:         if (-d $fn) {
  593:             unless (&empty_directory($fn,'Delete1')) {
  594:                 $request->print('<h3>'.&mt('Only empty directories may be deleted.').'</h3>'.
  595:                             'You must delete the contents of the directory first.<br />'.
  596:                             '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
  597:                 return;
  598:             }
  599:         } else { 
  600: 	    unless (&obsolete_unpub($user,$domain,$fn)) {
  601: 	        $request->print('<h3>'.&mt('Cannot delete non-obsolete published file').'</h3>'.
  602: 			    '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
  603: 	        return;
  604: 	    }
  605:         }
  606: 	$request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>');
  607: 	&CloseForm1($request, $fn);
  608:     } else {
  609: 	$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
  610:     }
  611: }
  612: 
  613: =pod
  614: 
  615: =item Copy1($request, $user, $domain, $filename, $newfilename)
  616: 
  617:    Performs phase 1 processing of the construction space copy command.
  618:    Ensure that the source file exists.  Ensure that a destination exists,
  619:    also warn if the destination already exists.
  620: 
  621: Parameters:
  622: 
  623: =over 4
  624: 
  625: =item   $request   - Apache Request Object [in] request object for the current 
  626:                 request.
  627: 
  628: =item   $user      - string [in]  Name of the user initiating the request.
  629: 
  630: =item   $domain    - string [in]  Domain the initiating user is logged in as
  631: 
  632: =item   $fn  - string [in]  Source filename.
  633: 
  634: =item   $newfilename-string [in]  Destination filename.
  635: 
  636: =back
  637: 
  638: =cut
  639: 
  640: sub Copy1 {
  641:     my ($request, $user, $domain, $fn, $newfilename) = @_;
  642: 
  643:     if(-e $fn) {
  644: 	# is dest a dir
  645: 	if (-d $newfilename) {
  646: 	    if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; }
  647: 	}
  648: 	if ($newfilename =~ m|/[^\.]+$|) {
  649: 	    #no extension add on original extension
  650: 	    if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {	$newfilename.='.'.$1; }
  651: 	} 
  652: 	$newfilename=~s://+:/:g; # remove duplicate /
  653: 	while ($newfilename=~m:/\.\./:) {
  654: 	    $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
  655: 	}
  656: 	$request->print(&checksuffix($fn,$newfilename));
  657: 	my ($type,$return)=&exists($user, $domain, $newfilename);
  658: 	$request->print($return);
  659: 	if ($type eq 'error') {
  660: 	    $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
  661: 	    return;
  662: 	}
  663: 	$request->print('<input type="hidden" name="newfilename" value="'.
  664: 			$newfilename.
  665: 			'" /><p>'.&mt('Copy').' '.&display($fn).'<br />to '.
  666: 			&display($newfilename).'?</p>');
  667: 	&CloseForm1($request, $fn);
  668:     } else {
  669: 	$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
  670:     }
  671: }
  672: 
  673: =pod
  674: 
  675: =item NewDir1
  676:  
  677:   Does all phase 1 processing of directory creation:
  678:   Ensures that the user provides a new directory name,
  679:   and that the directory does not already exist.
  680: 
  681: Parameters:
  682: 
  683: =over 4
  684: 
  685: =item   $request  - Apache Request Object [in] - Server request object for the
  686:                current url.
  687: 
  688: =item   $username - Name of the user that is requesting the directory creation.
  689: 
  690: =item $domain - Domain user is in
  691: 
  692: =item   $fn     - source file.
  693: 
  694: =item   $newdir   - Name of the directory to be created; path relative to the 
  695:                top level of construction space.
  696: =back
  697: 
  698: Side Effects:
  699: 
  700: =over 4
  701: 
  702: =item A new form is displayed.  Clicking on the confirmation button
  703: causes the newdir operation to transition into phase 2.  The hidden field
  704: "newfilename" is set with the construction space path to the new directory.
  705: 
  706: 
  707: =back
  708: 
  709: =cut
  710: 
  711: 
  712: sub NewDir1 {
  713:     my ($request, $username, $domain, $fn, $newfilename, $mode) = @_;
  714: 
  715:     my ($type, $result)=&exists($username,$domain,$newfilename,'directory');
  716:     $request->print($result);
  717:     if ($type eq 'error') {
  718: 	$request->print('</form>');
  719:     } else {
  720: 	if ($mode eq 'testbank') {
  721: 	    $request->print('<input type="hidden" name="callingmode" value="testbank" />');
  722: 	} elsif ($mode eq 'imsimport') {
  723: 	    $request->print('<input type="hidden" name="callingmode" value="imsimport" />');
  724: 	}
  725: 	$request->print('<input type="hidden" name="newfilename" value="'.
  726: 			$newfilename.'" /><p>'.&mt('Make new directory').' '.
  727: 			&display($newfilename).'?</p>');
  728: 	&CloseForm1($request, $fn);
  729:     }
  730: }
  731: 
  732: 
  733: sub Decompress1 {
  734:     my ($request, $user, $domain, $fn) = @_;
  735:     if( -e $fn) {
  736:    	$request->print('<input type="hidden" name="newfilename" value="'.$fn.'" />');
  737:    	$request->print('<p>'.&mt('Decompress').' '.&display($fn).'?</p>');
  738:    	&CloseForm1($request, $fn);
  739:     } else {
  740: 	$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
  741:     }
  742: }
  743: 
  744: =pod
  745: 
  746: =item NewFile1
  747:  
  748:   Does all phase 1 processing of file creation:
  749:   Ensures that the user provides a new filename, adds proper extension
  750:   if needed and that the file does not already exist, if it is a html,
  751:   problem, page, or sequence, it then creates a form link to hand the
  752:   actual creation off to the proper handler.
  753: 
  754: Parameters:
  755: 
  756: =over 4
  757: 
  758: =item   $request  - Apache Request Object [in] - Server request object for the
  759:                current url.
  760: 
  761: =item   $username - Name of the user that is requesting the directory creation.
  762: 
  763: =item   $domain   - Name of the domain of the user
  764: 
  765: =item   $fn      - Source file name
  766: 
  767: =item   $newfilename
  768:                   - Name of the file to be created; no path information
  769: =back
  770: 
  771: Side Effects:
  772: 
  773: =over 4
  774: 
  775: =item 2 new forms are displayed.  Clicking on the confirmation button
  776: causes the browser to attempt to load the specfied URL, allowing the
  777: proper handler to take care of file creation. There is also a Cancel
  778: button which returns you to the driectory listing you came from
  779: 
  780: =back
  781: 
  782: =cut
  783: 
  784: sub NewFile1 {
  785:     my ($request, $user, $domain, $fn, $newfilename) = @_;
  786:     return if (&filename_check($newfilename) ne 'ok');
  787: 
  788:     if ($env{'form.action'} =~ /new(.+)file/) {
  789: 	my $extension=$1;
  790: 	if ($newfilename !~ /\Q.$extension\E$/) {
  791: 	    if ($newfilename =~ m|/[^/.]*\.(?:[^/.]+)$|) {
  792: 		#already has an extension strip it and add in expected one
  793: 		$newfilename =~ s|(/[^./])\.(?:[^.]+)$|$1|;
  794: 	    }
  795: 	    $newfilename.=".$extension";
  796: 	}
  797:     }
  798:     my ($type, $result)=&exists($user,$domain,$newfilename);
  799:     $request->print($result);
  800:     if ($type eq 'error') {
  801: 	$request->print('</form>');
  802:     } else {
  803:         my $extension;
  804: 
  805:         if ($newfilename =~ m{[^/.]+\.([^/.]+)$}) {
  806:             $extension = $1;
  807:         }
  808: 
  809:         my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty library js css txt);
  810:         if (($extension eq '') || (!grep(/^\Q$extension\E/,@okexts))) {
  811:             my $validexts = '.'.join(', .',@okexts);
  812:             $request->print('<p class="LC_warning">'.
  813:                 &mt('Invalid filename: ').&display($newfilename).'</p><p>'.
  814:                 &mt('The name of the new file needs to end with an appropriate file extension to indicate the type of file to create.').'<br />'.
  815:                 &mt('The following are valid extensions: [_1].',$validexts).
  816:                 '</p></form><p>'.
  817: 		'<form name="fileaction" action="/adm/cfile" method="post">'.
  818:                 '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
  819: 		'<input type="hidden" name="action" value="newfile" />'.
  820: 	        '<span class ="LC_nobreak">'.&mt('Enter a file name: ').'<input type="text" name="newfilename" value="Type Name Here" onfocus="if (this.value == '."'Type Name Here') this.value=''".'" />&nbsp;<input type="submit" value="Go" />'.
  821:                 '</span></form></p>'.
  822:                 '<p><form action="'.&url($fn).
  823:                 '" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>');
  824:             return;
  825:         }
  826: 
  827: 	$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');
  828: 	$request->print('</form>');
  829: 
  830: 	$request->print('<form action="'.&url($newfilename).
  831: 			'" method="POST"><p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
  832: 	$request->print('<form action="'.&url($fn).
  833: 			'" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
  834:     }
  835:     return;
  836: }
  837: 
  838: sub filename_check {
  839:     my ($newfilename) = @_;
  840:     ##Informs User (name).(number).(extension) not allowed
  841:     if($newfilename =~ /\.(\d+)\.(\w+)$/){
  842:         $r->print('<span class="LC_error">'.$newfilename.
  843:                   ' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '.
  844:                   ' '.&mt('Not Allowed').'</span>');
  845:         return;
  846:     }
  847:     if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){
  848:         $r->print('<span class="LC_error">'.$newfilename.
  849:                   ' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '.
  850:                   ' '.&mt('Not Allowed').'</span>');
  851:         return;
  852:     }
  853:     return 'ok'; 
  854: }
  855: 
  856: =pod
  857: 
  858: =item phaseone($r, $fn, $uname, $udom)
  859: 
  860:   Peforms phase one processing of the request.  In phase one, error messages
  861: are returned if the request cannot be performed (e.g. attempts to manipulate
  862: files that are nonexistent).  If the operation can be performed, what is
  863: about to be done will be presented to the user for confirmation.  If the
  864: user confirms the request, then phase two is executed, the action 
  865: performed and reported to the user.
  866: 
  867:  Parameters:
  868: 
  869: =over 4
  870: 
  871: =item $r  - request object [in] - The Apache request being executed.
  872: 
  873: =item $fn = string [in] - The filename being manipulated by the 
  874:                              request.
  875: 
  876: =item $uname - string [in] Name of user logged in and doing this action.
  877: 
  878: =item $udom  - string [in] Domain name under which the user logged in. 
  879: 
  880: =back
  881: 
  882: =cut
  883: 
  884: sub phaseone {
  885:     my ($r,$fn,$uname,$udom)=@_;
  886:   
  887:     my $doingdir=0;
  888:     if ($env{'form.action'} eq 'newdir') { $doingdir=1; }
  889:     my $newfilename=&cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname);
  890:     $newfilename=&relativeDest($fn,$newfilename,$uname);
  891:     $r->print('<form action="/adm/cfile" method="post">'.
  892: 	      '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
  893: 	      '<input type="hidden" name="phase" value="two" />'.
  894: 	      '<input type="hidden" name="action" value="'.$env{'form.action'}.'" />');
  895:   
  896:     if ($env{'form.action'} eq 'rename') {
  897: 	&Rename1($r, $uname, $udom, $fn, $newfilename, 'rename');
  898:     } elsif ($env{'form.action'} eq 'move') {
  899: 	&Rename1($r, $uname, $udom, $fn, $newfilename, 'move');
  900:     } elsif ($env{'form.action'} eq 'delete') { 
  901: 	&Delete1($r, $uname, $udom, $fn);
  902:     } elsif ($env{'form.action'} eq 'decompress') {
  903: 	&Decompress1($r, $uname, $udom, $fn);
  904:     } elsif ($env{'form.action'} eq 'copy') { 
  905: 	if($newfilename) {
  906: 	    &Copy1($r, $uname, $udom, $fn, $newfilename);
  907: 	} else {
  908: 	    $r->print('<p>'.&mt('No new filename specified.').'</p></form>');
  909: 	}
  910:     } elsif ($env{'form.action'} eq 'newdir') {
  911: 	my $mode = '';
  912: 	if (exists($env{'form.callingmode'}) ) {
  913: 	    $mode = $env{'form.callingmode'};
  914: 	}   
  915: 	&NewDir1($r, $uname, $udom, $fn, $newfilename, $mode);
  916:     }  elsif ($env{'form.action'} eq 'newfile' ||
  917: 	      $env{'form.action'} eq 'newhtmlfile' ||
  918: 	      $env{'form.action'} eq 'newproblemfile' ||
  919: 	      $env{'form.action'} eq 'newpagefile' ||
  920: 	      $env{'form.action'} eq 'newsequencefile' ||
  921: 	      $env{'form.action'} eq 'newrightsfile' ||
  922: 	      $env{'form.action'} eq 'newstyfile' ||
  923: 	      $env{'form.action'} eq 'newtaskfile' ||
  924:               $env{'form.action'} eq 'newlibraryfile' ||
  925: 	      $env{'form.action'} eq 'Select Action') {
  926:         my $empty=&mt('Type Name Here');
  927: 	if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) {
  928: 	    &NewFile1($r, $uname, $udom, $fn, $newfilename);
  929: 	} else {
  930: 	    $r->print('<p>'.&mt('No new filename specified.').'</p></form>');
  931: 	}
  932:     }
  933: }
  934: 
  935: =pod
  936: 
  937: =item Rename2($request, $user, $directory, $oldfile, $newfile)
  938: 
  939: Performs phase 2 processing of a rename reequest.   This is where the
  940: actual rename is performed.
  941: 
  942: Parameters
  943: 
  944: =over 4
  945: 
  946: =item $request - Apache request object [in] The request being processed.
  947: 
  948: =item $user  - string [in] The name of the user initiating the request.
  949: 
  950: =item $directory - string [in] The name of the directory relative to the
  951:                  construction space top level of the renamed file.
  952: 
  953: =item $oldfile - Name of the file.
  954: 
  955: =item $newfile - Name of the new file.
  956: 
  957: =back
  958: 
  959: Returns:
  960: 
  961: =over 4
  962: 
  963: =item 1 Success.
  964: 
  965: =item 0 Failure.
  966: 
  967: =cut
  968: 
  969: sub Rename2 {
  970: 
  971:     my ($request, $user, $directory, $oldfile, $newfile) = @_;
  972: 
  973:     &Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile.
  974: 	   " new file ".$newfile."\n");
  975:     &Debug($request, "Target is: ".$directory.'/'.
  976: 	   $newfile);
  977:     if (-e $oldfile) {
  978: 
  979: 	my $oRN=$oldfile;
  980: 	my $nRN=$newfile;
  981: 	unless (rename($oldfile,$newfile)) {
  982: 	    $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
  983: 	    return 0;
  984: 	}
  985: 	## If old name.(extension) exits, move under new name.
  986: 	## If it doesn't exist and a new.(extension) exists  
  987: 	## delete it (only concern when renaming over files)
  988: 	my $tmp1=$oRN.'.meta';
  989: 	my $tmp2=$nRN.'.meta';
  990: 	if(-e $tmp1){
  991: 	    unless(rename($tmp1,$tmp2)){ }
  992: 	} elsif(-e $tmp2){
  993: 	    unlink $tmp2;
  994: 	}
  995: 	$tmp1=$oRN.'.save';
  996: 	$tmp2=$nRN.'.save';
  997: 	if(-e $tmp1){
  998: 	    unless(rename($tmp1,$tmp2)){ }
  999: 	} elsif(-e $tmp2){
 1000: 	    unlink $tmp2;
 1001: 	}
 1002: 	$tmp1=$oRN.'.log';
 1003: 	$tmp2=$nRN.'.log';
 1004: 	if(-e $tmp1){
 1005: 	    unless(rename($tmp1,$tmp2)){ }
 1006: 	} elsif(-e $tmp2){
 1007: 	    unlink $tmp2;
 1008: 	}
 1009: 	$tmp1=$oRN.'.bak';
 1010: 	$tmp2=$nRN.'.bak';
 1011: 	if(-e $tmp1){
 1012: 	    unless(rename($tmp1,$tmp2)){ }
 1013: 	} elsif(-e $tmp2){
 1014: 	    unlink $tmp2;
 1015: 	}
 1016:     } else {
 1017: 	$request->print("<p> ".&mt('No such file').": ".&display($oldfile).'</p></form>');
 1018: 	return 0;
 1019:     }
 1020:     return 1;
 1021: }
 1022: 
 1023: =pod
 1024: 
 1025: =item Delete2($request, $user, $filename)
 1026: 
 1027:   Performs phase two of a delete.  The user has confirmed that they want 
 1028: to delete the selected file.   The file is deleted and the results of the
 1029: delete attempt are indicated.
 1030: 
 1031: Parameters:
 1032: 
 1033: =over 4
 1034: 
 1035: =item $request - Apache Request object [in] the request object for the current
 1036:                  delete operation.
 1037: 
 1038: =item $user    - string [in]  The name of the user initiating the delete
 1039:                  request.
 1040: 
 1041: =item $filename - string [in] The name of the file, relative to construction
 1042:                   space, to delete.
 1043: 
 1044: =back
 1045: 
 1046: Returns:
 1047:   1 - success.
 1048:   0 - Failure.
 1049: 
 1050: =cut
 1051: 
 1052: sub Delete2 {
 1053:     my ($request, $user, $filename) = @_;
 1054:     if (-d $filename) { 
 1055: 	unless (&empty_directory($filename,'Delete2')) { 
 1056: 	    $request->print('<span class="LC_error">'.&mt('Error: Directory Non Empty').'</span>'); 
 1057: 	    return 0;
 1058: 	} else {   
 1059: 	    if(-e $filename) {
 1060: 		unless(rmdir($filename)) {
 1061: 		    $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
 1062: 		    return 0;
 1063: 		}
 1064: 	    } else {
 1065: 		$request->print('<p> '.&mt('No such file').'. </p></form>');
 1066: 		return 0;
 1067: 	    }
 1068: 	}
 1069:     } else {
 1070: 	if(-e $filename) {
 1071: 	    unless(unlink($filename)) {
 1072: 		$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
 1073: 		return 0;
 1074: 	    }
 1075: 	} else {
 1076: 	    $request->print('<p> '.&mt('No such file').'. </p></form>');
 1077: 	    return 0;
 1078: 	}
 1079:     }
 1080:     return 1;
 1081: }
 1082: 
 1083: =pod
 1084: 
 1085: =item Copy2($request, $username, $dir, $oldfile, $newfile)
 1086: 
 1087:    Performs phase 2 of a copy.  The file is copied and the status 
 1088:    of that copy is reported back to the user.
 1089: 
 1090: =over 4
 1091: 
 1092: =item $request - Apache request object [in]; the apache request currently
 1093:                  being executed.
 1094: 
 1095: =item $username - string [in] Name of the user who is requesting the copy.
 1096: 
 1097: =item $dir - string [in] Directory path relative to the construction space
 1098:              of the destination file.
 1099: 
 1100: =item $oldfile - string [in] Name of the source file.
 1101: 
 1102: =item $newfile - string [in] Name of the destination file.
 1103: 
 1104: 
 1105: =back
 1106: 
 1107: Returns 0 failure, and 1 successs.
 1108: 
 1109: =cut
 1110: 
 1111: sub Copy2 {
 1112:     my ($request, $username, $dir, $oldfile, $newfile) = @_;
 1113:     &Debug($request ,"Will try to copy $oldfile to $newfile");
 1114:     if(-e $oldfile) {
 1115:         if ($oldfile eq $newfile) {
 1116:             $request->print('<span class="LC_error">'.&mt('Warning').': '.&mt('Name of new file is the same as name of old file').' - '.&mt('no action taken').'.</span>');
 1117:             return 1;
 1118:         }
 1119: 	unless (copy($oldfile, $newfile)) {
 1120: 	    $request->print('<span class="LC_error">'.&mt('copy Error').': '.$!.'</span>');
 1121: 	    return 0;
 1122: 	} elsif (!chmod(0660, $newfile)) {
 1123: 	    $request->print('<span class="LC_error">'.&mt('chmod error').': '.$!.'</span>');
 1124: 	    return 0;
 1125: 	} elsif (-e $oldfile.'.meta' && 
 1126: 		 !copy($oldfile.'.meta', $newfile.'.meta') &&
 1127: 		 !chmod(0660, $newfile.'.meta')) {
 1128: 	    $request->print('<span class="LC_error">'.&mt('copy metadata error').
 1129: 			    ': '.$!.'</span>');
 1130: 	    return 0;
 1131: 	} else {
 1132: 	    return 1;
 1133: 	}
 1134:     } else {
 1135: 	$request->print('<p> '.&mt('No such file').' </p>');
 1136: 	return 0;
 1137:     }
 1138:     return 1;
 1139: }
 1140: 
 1141: =pod
 1142: 
 1143: =item NewDir2($request, $user, $newdirectory)
 1144: 
 1145: 	Performs phase 2 processing of directory creation.  This involves creating the directory and
 1146: 	reporting the results of that creation to the user.
 1147: 	
 1148: Parameters:
 1149: =over 4
 1150: 
 1151: =item $request  - Apache request object [in].  Object representing the current HTTP request.
 1152: 
 1153: =item $user - string [in] The name of the user that is initiating the request.
 1154: 
 1155: =item $newdirectory - string [in] The full path of the directory being created.
 1156: 
 1157: =back
 1158: 
 1159: Returns 0 - failure 1 - success.
 1160: 
 1161: =cut
 1162: 
 1163: sub NewDir2 {
 1164:     my ($request, $user, $newdirectory) = @_;
 1165:   
 1166:     unless(mkdir($newdirectory, 02770)) {
 1167: 	$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
 1168: 	return 0;
 1169:     }
 1170:     unless(chmod(02770, ($newdirectory))) {
 1171: 	$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
 1172: 	return 0;
 1173:     }
 1174:     return 1;
 1175: }
 1176: 
 1177: sub decompress2 {
 1178:     my ($r, $user, $dir, $file) = @_;
 1179:     &Apache::lonnet::appenv({'cgi.file' => $file});
 1180:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
 1181:     my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
 1182:     $r->print($result);
 1183:     &Apache::lonnet::delenv('cgi.file');
 1184:     &Apache::lonnet::delenv('cgi.dir');
 1185:     return 1;
 1186: }
 1187: 
 1188: =pod
 1189: 
 1190: =item phasetwo($r, $fn, $uname, $udom)
 1191: 
 1192:    Controls the phase 2 processing of file management
 1193:    requests for construction space.  In phase one, the user
 1194:    was asked to confirm the operation.  In phase 2, the operation
 1195:    is performed and the result is shown.
 1196: 
 1197:   The strategy is to break out the processing into specific action processors
 1198:   named action2 where action is the requested action and the 2 denotes 
 1199:   phase 2 processing.
 1200: 
 1201: Parameters:
 1202: 
 1203: =over 4
 1204: 
 1205: =item  $r     - Apache Request object [in] The request object for this httpd
 1206:            transaction.
 1207: 
 1208: =item  $fn    - string [in]  A filename indicating the object that is being
 1209:            manipulated.
 1210: 
 1211: =item  $uname - string [in] The name of the user initiating the file management
 1212:            request.
 1213: 
 1214: =item  $udom  - string  [in] The login domain of the user initiating the
 1215:            file management request.
 1216: =back
 1217: 
 1218: =cut
 1219: 
 1220: sub phasetwo {
 1221:     my ($r,$fn,$uname,$udom)=@_;
 1222:     
 1223:     &Debug($r, "loncfile - Entering phase 2 for $fn");
 1224:     
 1225:     # Break down the file into its component pieces.
 1226:     
 1227:     my $dir;		# Directory path
 1228:     my $main;		# Filename.
 1229:     my $suffix;		# Extension.
 1230:     if ($fn=~m:(.*)/([^/]+):) {
 1231: 	$dir=$1;		# Directory path
 1232: 	$main=$2;		# Filename.
 1233:     }
 1234:     if($main=~m:\.(\w+)$:){ # Fixes problems with filenames with no extensions
 1235: 	$suffix=$1; #This is the actually filename extension if it exists
 1236: 	$main=~s/\.\w+$//; #strip the extension
 1237:     }
 1238:     my $dest;                       #
 1239:     my $dest_dir;                   # On success this is where we'll go.
 1240:     my $disp_newname;               #
 1241:     my $dest_newname;               #
 1242:     &Debug($r,"loncfile::phase2 dir = $dir main = $main suffix = $suffix");
 1243:     &Debug($r,"    newfilename = ".$env{'form.newfilename'});
 1244: 
 1245:     my $conspace=$fn;
 1246:     
 1247:     &Debug($r,"loncfile::phase2 Full construction space name: $conspace");
 1248:     
 1249:     &Debug($r,"loncfie::phase2 action is $env{'form.action'}");
 1250:     
 1251:     # Select the appropriate processing sub.
 1252:     if ($env{'form.action'} eq 'decompress') { 
 1253: 	$main .= '.'.$suffix;
 1254: 	if(!&decompress2($r, $uname, $dir, $main)) {
 1255: 	    return ;
 1256: 	}
 1257: 	$dest = $dir."/.";
 1258:     } elsif ($env{'form.action'} eq 'rename' ||
 1259: 	     $env{'form.action'} eq 'move') {
 1260: 	if($env{'form.newfilename'}) {
 1261: 	    if (!defined($dir)) {
 1262: 		$fn=~m:^(.*)/:;
 1263: 		$dir=$1; 
 1264: 	    }
 1265: 	    if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) {
 1266: 		return;
 1267: 	    }
 1268: 	    $dest = $dir."/";
 1269: 	    $dest_newname = $env{'form.newfilename'};
 1270: 	    $env{'form.newfilename'} =~ /.+(\/.+$)/;
 1271: 	    $disp_newname = $1;
 1272: 	    $disp_newname =~ s/\///;
 1273: 	}
 1274:     } elsif ($env{'form.action'} eq 'delete') { 
 1275: 	if(!&Delete2($r, $uname, $env{'form.newfilename'})) {
 1276: 	    return ;
 1277: 	}
 1278: 	# Once a resource is deleted, we just list the directory that
 1279: 	# previously held it.
 1280: 	#
 1281: 	$dest = $dir."/.";		# Parent dir.
 1282:     } elsif ($env{'form.action'} eq 'copy') { 
 1283: 	if($env{'form.newfilename'}) {
 1284: 	    if(!&Copy2($r, $uname, $dir, $fn, $env{'form.newfilename'})) {
 1285: 		return ;
 1286: 	    }
 1287: 	    $dest = $env{'form.newfilename'};
 1288:      	} else {
 1289: 	    $r->print('<p>'.&mt('No New filename specified').'</p></form>');
 1290: 	    return;
 1291: 	}
 1292: 	
 1293:     } elsif ($env{'form.action'} eq 'newdir') {
 1294:         my $newdir= $env{'form.newfilename'};
 1295: 	if(!&NewDir2($r, $uname, $newdir)) {
 1296: 	    return;
 1297: 	}
 1298: 	$dest = $newdir."/";
 1299:     }
 1300:     if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
 1301: 	$r->print('<h3><a href="javascript:self.close()">'.&mt('Done').'</a></h3>');
 1302:     } else {
 1303:         if ($env{'form.action'} eq 'rename') {
 1304:             $r->print('<h3><a href="'.&url($dest).'">'.&mt('Return to Directory').'</a></h3>');
 1305:             $r->print('<h3><a href="'.&url($dest_newname).'">'.$disp_newname.'</a></h3>');
 1306:         } else {
 1307: 	    $r->print(&done(&url($dest)));
 1308: 	}
 1309:     }
 1310: }
 1311: 
 1312: sub handler {
 1313: 
 1314:     $r=shift;
 1315: 
 1316:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress','action','filename','newfilename']);
 1317: 
 1318:     &Debug($r, "loncfile.pm - handler entered");
 1319:     &Debug($r, " filename: ".$env{'form.filename'});
 1320:     &Debug($r, " newfilename: ".$env{'form.newfilename'});
 1321: #
 1322: # Determine the root filename
 1323: # This could come in as "filename", which actually is a URL, or
 1324: # as "qualifiedfilename", which is indeed a real filename in filesystem
 1325: #
 1326:     my $fn;
 1327: 
 1328:     if ($env{'form.filename'}) {
 1329: 	&Debug($r, "test: $env{'form.filename'}");
 1330: 	$fn=&unescape($env{'form.filename'});
 1331: 	$fn=&URLToPath($fn);
 1332:     }  elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') {  
 1333: 	#Just hijack the script only the first time around to inject the
 1334: 	#correct information for further processing
 1335: 	$fn=&unescape($env{'form.decompress'});
 1336: 	$fn=&URLToPath($fn);
 1337: 	$env{'form.action'}="decompress";
 1338:     } elsif ($env{'form.qualifiedfilename'}) {
 1339: 	$fn=$env{'form.qualifiedfilename'};
 1340:     } else {
 1341: 	&Debug($r, "loncfile::handler - no form.filename");
 1342: 	$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
 1343: 		       ' unspecified filename for cfile', $r->filename); 
 1344: 	return HTTP_NOT_FOUND;
 1345:     }
 1346: 
 1347:     unless ($fn) { 
 1348: 	&Debug($r, "loncfile::handler - doctored url is empty");
 1349: 	$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
 1350: 		       ' trying to cfile non-existing file', $r->filename); 
 1351: 	return HTTP_NOT_FOUND;
 1352:     } 
 1353: 
 1354: # ----------------------------------------------------------- Start page output
 1355:     my $uname;
 1356:     my $udom;
 1357: 
 1358:     ($uname,$udom)=
 1359: 	&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
 1360:     &Debug($r, 
 1361: 	   "loncfile::handler constructaccess uname = $uname domain = $udom");
 1362:     unless (($uname) && ($udom)) {
 1363: 	$r->log_reason($uname.' at '.$udom.
 1364: 		       ' trying to manipulate file '.$env{'form.filename'}.
 1365: 		       ' ('.$fn.') - not authorized', 
 1366: 		       $r->filename); 
 1367: 	return HTTP_NOT_ACCEPTABLE;
 1368:     }
 1369: 
 1370: 
 1371:     &Apache::loncommon::content_type($r,'text/html');
 1372:     $r->send_http_header;
 1373: 
 1374:     my (%loaditem,$js);
 1375: 
 1376:     if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
 1377: 	my $newdirname = $env{'form.newfilename'};
 1378: 	$js = qq|
 1379: <script type="text/javascript">
 1380: function writeDone() {
 1381:     window.focus();
 1382:     opener.document.info.newdir.value = "$newdirname";
 1383:     setTimeout("self.close()",10000);
 1384: }
 1385:   </script>
 1386: |;
 1387: 	$loaditem{'onload'} = "writeDone()";
 1388:     }
 1389:     
 1390:     $r->print(&Apache::loncommon::start_page('Construction Space File Operation',
 1391: 					     $js,
 1392: 					     {'add_entries' => \%loaditem,}));
 1393:   
 1394:     $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
 1395:   
 1396:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
 1397:         $r->print('<p class="LC_warning">'
 1398:                  .&mt('Co-Author [_1]:[_2]',$uname,$udom)
 1399:                  .'</p>'
 1400:         );
 1401:     }
 1402: 
 1403: 
 1404:     &Debug($r, "loncfile::handler Form action is $env{'form.action'} ");
 1405:     if ($env{'form.action'} eq 'delete') {
 1406:       	$r->print('<h3>'.&mt('Delete').'</h3>');
 1407:     } elsif ($env{'form.action'} eq 'rename') {
 1408: 	$r->print('<h3>'.&mt('Rename').'</h3>');
 1409:     } elsif ($env{'form.action'} eq 'move') {
 1410: 	$r->print('<h3>'.&mt('Move').'</h3>');
 1411:     } elsif ($env{'form.action'} eq 'newdir') {
 1412: 	$r->print('<h3>'.&mt('New Directory').'</h3>');
 1413:     } elsif ($env{'form.action'} eq 'decompress') {
 1414: 	$r->print('<h3>'.&mt('Decompress').'</h3>');
 1415:     } elsif ($env{'form.action'} eq 'copy') {
 1416: 	$r->print('<h3>'.&mt('Copy').'</h3>');
 1417:     } elsif ($env{'form.action'} eq 'newfile' ||
 1418: 	     $env{'form.action'} eq 'newhtmlfile' ||
 1419: 	     $env{'form.action'} eq 'newproblemfile' ||
 1420: 	     $env{'form.action'} eq 'newpagefile' ||
 1421: 	     $env{'form.action'} eq 'newsequencefile' ||
 1422: 	     $env{'form.action'} eq 'newrightsfile' ||
 1423: 	     $env{'form.action'} eq 'newstyfile' ||
 1424: 	     $env{'form.action'} eq 'newtaskfile' ||
 1425:              $env{'form.action'} eq 'newlibraryfile' ||
 1426: 	     $env{'form.action'} eq 'Select Action' ) {
 1427: 	$r->print('<h3>'.&mt('New Resource').'</h3>');
 1428:     } else {
 1429: 	$r->print('<p>'.&mt('Unknown Action').' '.$env{'form.action'}.' </p>'.
 1430: 		  &Apache::loncommon::end_page());
 1431: 	return OK;  
 1432:     }
 1433:     if ($env{'form.phase'} eq 'two') {
 1434: 	&Debug($r, "loncfile::handler  entering phase2");
 1435: 	&phasetwo($r,$fn,$uname,$udom);
 1436:     } else {
 1437: 	&Debug($r, "loncfile::handler  entering phase1");
 1438: 	&phaseone($r,$fn,$uname,$udom);
 1439:     }
 1440: 
 1441:     $r->print(&Apache::loncommon::end_page());
 1442:     return OK;  
 1443: }
 1444: 
 1445: 1;
 1446: __END__
 1447: 

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