Annotation of loncom/interface/portfolio.pm, revision 1.100

1.3       banghart    1: # Copyright Michigan State University Board of Trustees
                      2: #
                      3: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      4: #
                      5: # LON-CAPA is free software; you can redistribute it and/or modify
                      6: # it under the terms of the GNU General Public License as published by
                      7: # the Free Software Foundation; either version 2 of the License, or 
                      8: # (at your option) any later version.
                      9: #
                     10: # LON-CAPA is distributed in the hope that it will be useful,
                     11: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     12: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     13: # GNU General Public License for more details.
                     14: #
                     15: # You should have received a copy of the GNU General Public License
                     16: # along with LON-CAPA; if not, write to the Free Software
                     17: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     18: #
                     19: # /home/httpd/html/adm/gpl.txt
                     20: #
                     21: # http://www.lon-capa.org/
                     22: #
                     23: 
1.1       banghart   24: package Apache::portfolio;
                     25: use strict;
                     26: use Apache::Constants qw(:common :http);
1.2       banghart   27: use Apache::loncommon;
1.1       banghart   28: use Apache::lonnet;
1.2       banghart   29: use Apache::lontexconvert;
                     30: use Apache::lonfeedback;
                     31: use Apache::lonlocal;
1.82      albertel   32: use Apache::lonnet;
1.99      raeburn    33: use Apache::longroup;
1.16      banghart   34: 
                     35: # receives a file name and path stub from username/userfiles/portfolio/
                     36: # returns an anchor tag consisting encoding filename and currentpath
1.23      albertel   37: sub make_anchor {
1.94      raeburn    38:     my ($url, $filename, $current_path, $current_mode, $field_name,
                     39:         $continue_select,$group) = @_;
1.83      banghart   40:     if ($continue_select ne 'true') {$continue_select = 'false'};
1.94      raeburn    41:     my $anchor = '<a href="'.$url.'?selectfile='.$filename.'&currentpath='.$current_path.'&mode='.$current_mode.'&continue='.$continue_select.'&fieldname='.$field_name;
                     42:     if (defined($group)) {
                     43:         $anchor .= '&group='.$group;
                     44:     }
                     45:     $anchor .= '">'.$filename.'</a>';
1.8       albertel   46:     return $anchor;
1.6       banghart   47: }
1.24      albertel   48: my $dirptr=16384;
1.48      banghart   49: sub display_common {
1.94      raeburn    50:     my ($r,$url,$current_path,$is_empty,$dir_list,$group)=@_;
                     51:     my $groupitem;
                     52:     my $namespace = &get_namespace($group);
                     53:     my $port_path = &get_port_path($group);
                     54:     if (defined($group)) {
                     55:         $groupitem = '<input type="hidden" name="group" value="'.$group.'" />';
                     56:     } 
1.18      banghart   57:     my $iconpath= $r->dir_config('lonIconsURL') . "/";
1.88      albertel   58:     my %text=&Apache::lonlocal::texthash('upload' => 'Upload',
                     59: 					 'upload_label' =>  
                     60: 					 'Upload file to current directory:',
                     61: 					 'createdir' => 'Create Subdirectory',
                     62: 					 'createdir_label' => 
                     63: 					 'Create subdirectory in current directory:');
                     64:     $r->print(<<"TABLE"); 
                     65: <table border="0" cellspacing="2" cellpadding="2">
                     66:   <form method="post" enctype="multipart/form-data">
                     67:     <tr valign="middle">
                     68:       <td bgcolor="#ccddaa" align="right">
                     69:         $text{'upload_label'}
                     70:       </td>
1.94      raeburn    71:       <td bgcolor="#ccddaa" align="left">$groupitem
1.88      albertel   72:         <input name="uploaddoc" type="file" />
                     73: 	<input type="hidden" name="currentpath" value="$current_path" />
                     74: 	<input type="hidden" name="action" value="$env{"form.action"}" />
                     75: 	<input type="hidden" name="fieldname" value="$env{"form.fieldname"}" />
                     76: 	<input type="hidden" name="mode" value="$env{"form.mode"}" />
                     77: 	<input type="submit" name="storeupl" value="$text{'upload'}" />
                     78:       </td>
                     79:     </tr>
                     80:   </form>
                     81:   <form method="post">
                     82:     <tr>
                     83:       <td bgcolor="#ccddaa" align="right">
                     84:         $text{'createdir_label'}
                     85:       </td>
                     86:       <td bgcolor="#ccddaa" align="left">
1.94      raeburn    87:         <input name="newdir" type="input" />$groupitem
1.88      albertel   88:         <input type="hidden" name="currentpath" value="$current_path" />
                     89:         <input type="hidden" name="action" value="$env{"form.action"}" />
                     90:         <input type="hidden" name="fieldname" value="$env{"form.fieldname"}" />
                     91:         <input type="hidden" name="mode" value="$env{"form.mode"}" />
                     92:         <input type="submit" name="createdir" value="$text{'createdir'}" />
                     93:       </td>
                     94:     </tr>
                     95:   </form>
                     96: </table>
                     97: TABLE
1.24      albertel   98:     my @tree = split (/\//,$current_path);
1.94      raeburn    99:     $r->print('<font size="+2">'.&make_anchor($url,$port_path,'/',$env{"form.mode"},$env{"form.fieldname"},$env{"form.continue"},$group).'/');
1.19      banghart  100:     if (@tree > 1){
                    101:         my $newCurrentPath = '';
                    102:         for (my $i = 1; $i< @tree; $i++){
                    103:             $newCurrentPath .= $tree[$i].'/';
1.94      raeburn   104:             $r->print(&make_anchor($url,$tree[$i],'/'.$newCurrentPath, $env{"form.mode"},$env{"form.fieldname"}, $env{"form.continue"},$group).'/');
1.19      banghart  105:         }
                    106:     }
                    107:     $r->print('</font>');
1.94      raeburn   108:     &Apache::lonhtmlcommon::store_recent($namespace,$current_path,$current_path);
                    109:     $r->print('<br /><form method=post action="'.$url.'?mode='.$env{"form.mode"}.'&fieldname='.$env{"form.fieldname"});
                    110:     if (defined($group)) {
                    111:         $r->print('&group='.$group);
                    112:     }
                    113:     $r->print('">'.
                    114: 	      &Apache::lonhtmlcommon::select_recent($namespace,'currentpath',
1.22      albertel  115: 						    'this.form.submit();'));
1.21      banghart  116:     $r->print("</form>");
1.48      banghart  117: }
                    118: sub display_directory {
1.94      raeburn   119:     my ($r,$url,$current_path,$is_empty,$dir_list,$group)=@_;
1.48      banghart  120:     my $iconpath= $r->dir_config('lonIconsURL') . "/";
1.94      raeburn   121:     my ($groupitem,$groupecho);
1.48      banghart  122:     my $display_out;
1.77      banghart  123:     my $select_mode;
                    124:     my $checked_files;
1.94      raeburn   125:     my $port_path = &get_port_path($group);
                    126:     my ($uname,$udom) = &get_name_dom($group);
                    127:     my $namespace = &get_namespace($group); 
                    128:     if (defined($group)) {
                    129:        $groupitem = '<input type="hidden" name="group" value="'.$group.'" />'; 
                    130:        $groupecho = '&amp;group='.$group;
                    131:     }
                    132:     my %locked_files = &Apache::lonnet::get_marked_as_readonly_hash ($namespace,$udom,$uname);
1.82      albertel  133:     if ($env{"form.mode"} eq 'selectfile'){
1.77      banghart  134: 	&select_files($r);
1.94      raeburn   135: 	$checked_files =&Apache::lonnet::files_in_path($uname,$env{'form.currentpath'});
1.77      banghart  136: 	$select_mode = 'true';
                    137:     } 
1.45      banghart  138:     if ($is_empty && ($current_path ne '/')) {
1.94      raeburn   139:         $display_out = '<form method="post" action="'.$url.'">'.$groupitem.
1.30      banghart  140:         '<input type="hidden" name="action" value="deletedir" />'.
                    141:         '<input type="submit" name="deletedir" value="'.&mt("Delete Directory").'" />'.
                    142:         '<input type="hidden" name="selectfile" value="" />'.
                    143:         '<input type="hidden" name="currentpath" value="'.$current_path.'" />'.
                    144:         '</form>';
                    145:         
1.48      banghart  146:         $r->print($display_out);
1.31      albertel  147: 	return;
                    148:     }
1.77      banghart  149:     if ($select_mode eq 'true') {
                    150:         $r->print('<table border="0" cellspacing="2" cellpadding="2">'.
                    151:             '<tr><th>Select</th><th>&nbsp;</th><th>Name</th><th>Size</th><th>Last Modified</th></tr>');
1.94      raeburn   152:         $r->print('<form method="post" name="checkselect" action="'.$url.'">');
1.77      banghart  153:     } else {
                    154:         $r->print('<table border="0" cellspacing="2" cellpadding="2">'.
1.70      banghart  155:             '<tr><th colspan="2">Actions</th><th>&nbsp;</th><th>Name</th><th>Size</th><th>Last Modified</th></tr>');
1.94      raeburn   156:         $r->print('<form method="post" action="'.$url.'">');
                    157:     }
                    158:     if (defined($group)) {
                    159:         $r->print("\n".$groupitem."\n");
1.77      banghart  160:     }
1.94      raeburn   161:     my $href_location="/uploaded/$udom/$uname/$port_path".$current_path;
                    162:     my $href_edit_location="/editupload/$udom/$uname/$port_path".$current_path;
1.26      albertel  163:     foreach my $line (sort 
                    164: 		      { 
                    165: 			  my ($afile)=split('&',$a,2);
                    166: 			  my ($bfile)=split('&',$b,2);
                    167: 			  return (lc($afile) cmp lc($bfile));
                    168: 		      } (@$dir_list)) {
1.18      banghart  169:     	#$strip holds directory/file name
                    170:     	#$dom 
1.23      albertel  171:     	my ($filename,$dom,undef,$testdir,undef,undef,undef,undef,$size,undef,$mtime,undef,undef,undef,$obs,undef)=split(/\&/,$line,16); 
1.77      banghart  172:     	$filename =~ s/\s+$//;
1.93      albertel  173:     	if (($filename ne '.') && ($filename ne '..') && ($filename !~ /\.meta$/ ) && ($filename !~ /(.*)\.(\d+)\.([^\.]*)$/)) {
1.23      albertel  174:             if ($dirptr&$testdir) {
1.77      banghart  175:                 if ($select_mode eq 'true'){
                    176:                     $r->print('<tr bgcolor="#FFAA99"><td><img src="'.$iconpath.'folder_closed.gif"></td>');
1.64      banghart  177:                 } else {
1.77      banghart  178:                     $r->print('<tr bgcolor="#FFAA99"><td colspan="2"><img src="'.$iconpath.'folder_closed.gif"></td>');
1.64      banghart  179:                 }
1.47      banghart  180:                 $r->print('<td>Go to ...</td>');
1.94      raeburn   181:                 $r->print('<td>'.&make_anchor($url,$filename.'/',$current_path.$filename.'/',$env{'form.mode'},$env{"form.fieldname"},$env{'form.continue'},$group).'</td>'); 
1.47      banghart  182:                 $r->print('</tr>'); 
                    183:             } else {
                    184:                 $r->print('<tr bgcolor="#CCCCFF">');
1.77      banghart  185:                 if ($select_mode eq 'true'){
1.83      banghart  186:                     $r->print('<td><input type="checkbox" name="checkfile" value="'.$filename.'"'); 
1.77      banghart  187:                     if ($$checked_files{$filename} eq 'selected') {
                    188:                         $r->print("CHECKED");
                    189:                     }
                    190:                     $r->print('></td>');
                    191:                 } else {
                    192:                     if (exists $locked_files{$current_path.$filename}){
1.94      raeburn   193:                         $r->print('<td colspan="2"><a href="'.$url.'?lockinfo='.$current_path.$filename.$groupecho.'">Locked</a></td>');
1.77      banghart  194:                     } else {
1.89      albertel  195: 			my $cat='<img alt="'.&mt('Catalog Information').
                    196: 			    '" src="'.&Apache::loncommon::lonhttpdurl('/res/adm/pages/catalog.gif').'" />';
1.77      banghart  197:                         $r->print('<td><input type="checkbox" name="selectfile" value="'.$filename.'" />
1.94      raeburn   198:                             <a href="'.$url.'?rename='.$filename.'&amp;currentpath='.$current_path.$groupecho.'">Rename</a></td>
1.89      albertel  199:                             <td><a href="'.$href_edit_location.$filename.'.meta">'.$cat.'</a>
1.77      banghart  200:                             </td>');
                    201:                     }
1.61      banghart  202:                 }
1.91      albertel  203:                 $r->print('<td><img src="'.&Apache::loncommon::icon($filename).'"></td>');
1.47      banghart  204:                 $r->print('<td><a href="'.$href_location.$filename.'">'.
                    205: 			    $filename.'</a></td>'); 
                    206:                 $r->print('<td>'.$size.'</td>');
                    207:                 $r->print('<td>'.&Apache::lonlocal::locallocaltime($mtime).'</td>');
                    208:                 $r->print('</tr>'); 
                    209:             }
                    210:         }
                    211:     }
1.77      banghart  212:     if ($select_mode eq 'true') {
                    213:         $r->print('</table>
1.60      banghart  214:             <input type="hidden" name="continue" value="true">
1.82      albertel  215:             <input type="hidden" name="fieldname" value="'.$env{'form.fieldname'}.'">
1.60      banghart  216:             <input type="hidden" name="mode" value="selectfile">
                    217:             <input type="submit" name="submit" value="Select checked files, and continue selecting." /><br />
1.48      banghart  218:             <input type="button" name="doit" onClick= "finishSelect();" value="Select checked files, and close window" />
                    219:             <input type="hidden" name="currentpath" value="'.$current_path.'" />
1.77      banghart  220:         </form>');        
                    221:     } else {
                    222:         $r->print('</table>
                    223:         <input type="submit" name="doit" value="Delete Checked Files" />
                    224:         <input type="hidden" name="action" value="delete" />
                    225:         <input type="hidden" name="currentpath" value="'.$current_path.'" />
                    226:         </form>');
                    227:     }
1.47      banghart  228: }
1.72      banghart  229: 
1.24      albertel  230: sub open_form {
1.94      raeburn   231:     my ($r,$url)=@_;
1.65      banghart  232:     my @files=&Apache::loncommon::get_env_multiple('form.selectfile');
1.94      raeburn   233:     $r->print('<form method="post" action="'.$url.'">');
1.24      albertel  234:     $r->print('<input type="hidden" name="action" value="'.
1.82      albertel  235: 	      $env{'form.action'}.'" />');
1.24      albertel  236:     $r->print('<input type="hidden" name="confirmed" value="1" />');
1.65      banghart  237:     foreach (@files) {
                    238:         $r->print('<input type="hidden" name="selectfile" value="'.
                    239: 	      $_.'" />');
                    240:     }
1.24      albertel  241:     $r->print('<input type="hidden" name="currentpath" value="'.
1.82      albertel  242: 	      $env{'form.currentpath'}.'" />');
1.24      albertel  243: }
                    244: 
                    245: sub close_form {
1.94      raeburn   246:     my ($r,$url,$group)=@_;
                    247:     $r->print('<p><input type="submit" value="'.&mt('Continue').'" />');
                    248:     if (defined($group)) {
                    249:        $r->print("\n".'<input type="hidden" name="group" value="'.
                    250:               $group.'" />');
                    251:     }
                    252:     $r->print('</p></form>');
                    253:     $r->print('<form action="'.$url.'" method="POST">
1.24      albertel  254:                <p>
                    255:               <input type="hidden" name="currentpath" value="'.
1.94      raeburn   256: 	      $env{'form.currentpath'}.'" />');
                    257:     if (defined($group)) {
                    258:        $r->print("\n".'<input type="hidden" name="group" value="'.
                    259:               $group.'" />');
                    260:     }
                    261:     $r->print("\n".'   <input type="submit" value="'.&mt('Cancel').'" />
                    262:                </p></form>'); 
1.24      albertel  263: }
                    264: 
                    265: sub display_file {
1.27      albertel  266:     my ($path,$filename)=@_;
1.65      banghart  267:     my $display_file_text;
1.82      albertel  268:     if (!defined($path)) { $path=$env{'form.currentpath'}; }
1.65      banghart  269:     if (!defined($filename)) { 
1.82      albertel  270:         $filename=$env{'form.selectfile'};
1.65      banghart  271:         $display_file_text = '<tt>'.$path.$filename.'</tt>';
                    272:     } elsif (ref($filename) eq "ARRAY") {
                    273:         foreach (@$filename) {
1.66      banghart  274:             $display_file_text .= '<tt>'.$path.$_.'</tt><br />';
1.65      banghart  275:         }
                    276:     } elsif (ref($filename) eq "SCALAR") {
                    277:         $display_file_text = '<tt>'.$path.$filename.'</tt>';        
                    278:     }
                    279:     return $display_file_text;
1.24      albertel  280: }
                    281: 
                    282: sub done {
1.94      raeburn   283:     my ($message,$url,$group)=@_;
1.76      banghart  284:     unless (defined $message) {
                    285:         $message='Done';
                    286:     }
1.94      raeburn   287:     my $result = '<h3><a href="'.$url.'?currentpath='.
                    288: 	         $env{'form.currentpath'}.
                    289: 	         '&fieldname='.$env{'form.fieldname'}.
                    290: 	         '&mode='.$env{'form.mode'};
                    291:     if (defined($group)) {
                    292:         $result .= '&group='.$group;
                    293:     }
                    294:     $result .= '">'.&mt($message).'</a></h3>';
                    295:     return $result;
1.24      albertel  296: }
                    297: 
                    298: sub delete {
1.94      raeburn   299:     my ($r,$url,$group)=@_;
1.55      banghart  300:     my @check;
1.82      albertel  301:     my $file_name = $env{'form.currentpath'}.$env{'form.selectfile'};
1.65      banghart  302:     my @files=&Apache::loncommon::get_env_multiple('form.selectfile');
1.94      raeburn   303:     my ($uname,$udom) = &get_name_dom($group);
                    304:     if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
1.55      banghart  305:         $r->print ("The file is locked and cannot be deleted.<br />");
1.94      raeburn   306:         $r->print(&done('Back',$url,$group));
1.55      banghart  307:     } else {
1.66      banghart  308:         if (scalar(@files)) {
1.94      raeburn   309:             &open_form($r,$url);
1.66      banghart  310:             $r->print('<p>'.&mt('Delete').' '.&display_file(undef,\@files).'?</p>');
1.94      raeburn   311:             &close_form($r,$url,$group);
1.66      banghart  312:         } else {
                    313:             $r->print("No file was checked to delete.<br />");
1.94      raeburn   314:             $r->print(&done(undef,$url,$group));
1.66      banghart  315:         }
1.55      banghart  316:     }
1.24      albertel  317: } 
                    318: 
                    319: sub delete_confirmed {
1.94      raeburn   320:     my ($r,$url,$group)=@_;
1.65      banghart  321:     my @files=&Apache::loncommon::get_env_multiple('form.selectfile');
                    322:     my $result;
1.94      raeburn   323:     my ($uname,$udom) = &get_name_dom($group);
                    324:     my $port_path = &get_port_path($group);
1.65      banghart  325:     foreach my $delete_file (@files) {
1.94      raeburn   326:         $result=&Apache::lonnet::removeuserfile($uname,$udom,$port_path.
1.82      albertel  327: 					       $env{'form.currentpath'}.
1.65      banghart  328: 					       $delete_file);
                    329:         if ($result ne 'ok') {
1.30      banghart  330: 	$r->print('<font color="red"> An error occured ('.$result.
1.65      banghart  331: 		  ') while trying to delete '.&display_file(undef, $delete_file).'</font><br />');
                    332:         }
1.24      albertel  333:     }
1.94      raeburn   334:     $r->print(&done(undef,$url,$group));
1.24      albertel  335: }
                    336: 
1.30      banghart  337: sub delete_dir {
1.94      raeburn   338:     my ($r,$url,$group)=@_;
                    339:     &open_form($r,$url);
1.30      banghart  340:     $r->print('<p>'.&mt('Delete').' '.&display_file().'?</p>');
1.94      raeburn   341:     &close_form($r,$url,$group);
1.30      banghart  342: } 
                    343: 
                    344: sub delete_dir_confirmed {
1.94      raeburn   345:     my ($r,$url,$group)=@_;
1.82      albertel  346:     my $directory_name = $env{'form.currentpath'};
1.81      albertel  347:     $directory_name =~ s|/$||; # remove any trailing slash
1.94      raeburn   348:     my ($uname,$udom) = &get_name_dom($group);
                    349:     my $namespace = &get_namespace($group);
                    350:     my $port_path = &get_port_path($group);
                    351:     my $result=&Apache::lonnet::removeuserfile($uname,$udom,$port_path.
1.30      banghart  352: 					       $directory_name);
1.32      banghart  353: 					       
1.30      banghart  354:     if ($result ne 'ok') {
                    355: 	$r->print('<font color="red"> An error occured (dir) ('.$result.
                    356: 		  ') while trying to delete '.$directory_name.'</font><br />');
1.32      banghart  357:     } else {
1.41      banghart  358:         # now remove from recent
                    359: #        $r->print('<br /> removing '.$directory_name.'<br /');
1.94      raeburn   360:         &Apache::lonhtmlcommon::remove_recent($namespace,[$directory_name.'/']);
1.32      banghart  361:         my @dirs = split m!/!, $directory_name;
                    362:         
                    363: #        $directory_name =~ m/^(\/*\/)(\/*.)$/;
                    364:         $directory_name='/';
                    365:         for (my $i=1; $i < (@dirs - 1); $i ++){
                    366:             $directory_name .= $dirs[$i].'/';
                    367:         }
1.82      albertel  368:         $env{'form.currentpath'} = $directory_name;
1.30      banghart  369:     }
1.94      raeburn   370:     $r->print(&done(undef,$url,$group));
1.30      banghart  371: }
                    372: 
1.24      albertel  373: sub rename {
1.94      raeburn   374:     my ($r,$url,$group)=@_;
1.82      albertel  375:     my $file_name = $env{'form.currentpath'}.$env{'form.rename'};
1.94      raeburn   376:     my ($uname,$udom) = &get_name_dom($group);
                    377:     if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
1.55      banghart  378:         $r->print ("The file is locked and cannot be renamed.<br />");
1.94      raeburn   379:         $r->print(&done(undef,$url,$group));
1.55      banghart  380:     } else {
1.94      raeburn   381:         &open_form($r,$url);
1.55      banghart  382:         $r->print('<p>'.&mt('Rename').' '.&display_file().' to 
                    383:                    <input name="filenewname" type="input" size="50" />?</p>');
1.94      raeburn   384:         &close_form($r,$url,$group);
1.55      banghart  385:     }
1.24      albertel  386: }
                    387: 
                    388: sub rename_confirmed {
1.94      raeburn   389:     my ($r,$url,$group)=@_;
1.82      albertel  390:     my $filenewname=&Apache::lonnet::clean_filename($env{'form.filenewname'});
1.94      raeburn   391:     my ($uname,$udom) = &get_name_dom($group);
                    392:     my $port_path = &get_port_path($group);
1.27      albertel  393:     if ($filenewname eq '') {
                    394: 	$r->print('<font color="red">'.
                    395: 		  &mt("Error: no valid filename was provided to rename to.").
                    396: 		  '</font><br />');
1.94      raeburn   397: 	$r->print(&done(undef,$url,$group));
1.27      albertel  398: 	return;
                    399:     } 
                    400:     my $result=
1.94      raeburn   401: 	&Apache::lonnet::renameuserfile($uname,$udom,
                    402:             $port_path.$env{'form.currentpath'}.$env{'form.selectfile'},
                    403:             $port_path.$env{'form.currentpath'}.$filenewname);
1.27      albertel  404:     if ($result ne 'ok') {
                    405: 	$r->print('<font color="red"> An errror occured ('.$result.
                    406: 		  ') while trying to rename '.&display_file().' to '.
                    407: 		  &display_file(undef,$filenewname).'</font><br />');
                    408:     }
1.82      albertel  409:     if ($filenewname ne $env{'form.filenewname'}) {
                    410:         $r->print("The new file name was changed from:<br /><strong>".$env{'form.filenewname'}."</strong> to <strong>$filenewname </strong>");
1.66      banghart  411:     }
1.94      raeburn   412:     $r->print(&done(undef,$url,$group));
1.27      albertel  413: }
1.47      banghart  414: sub select_files {
1.94      raeburn   415:     my ($r,$group)=@_;
1.82      albertel  416:     if ($env{'form.continue'} eq 'true') {
1.60      banghart  417:         # here we update the selections for the currentpath
                    418:         # eventually, have to handle removing those not checked, but . . . 
1.83      banghart  419:         my @items=&Apache::loncommon::get_env_multiple('form.checkfile');
                    420:         if (scalar(@items)){
1.85      banghart  421:              &Apache::lonnet::save_selected_files($env{'user.name'}, $env{'form.currentpath'}, @items);
1.83      banghart  422:         }
1.62      banghart  423:     } else {
                    424:             #empty the file for a fresh start
1.83      banghart  425:             &Apache::lonnet::clear_selected_files($env{'user.name'});
1.62      banghart  426:     }
1.82      albertel  427:     my @files = &Apache::lonnet::files_not_in_path($env{'user.name'}, $env{'form.currentpath'});
1.62      banghart  428:     my $java_files = join ",", @files;
                    429:     if ($java_files) {
                    430:         $java_files.=',';
1.60      banghart  431:     }
1.63      banghart  432:     my $javascript =(<<ENDSMP);
1.48      banghart  433:         <script language='javascript'>
                    434:         function finishSelect() {
1.62      banghart  435: ENDSMP
1.63      banghart  436:     $javascript .= 'fileList = "'.$java_files.'";';
                    437:     $javascript .= (<<ENDSMP);
1.49      banghart  438:             for (i=0;i<document.forms.checkselect.length;i++) { 
                    439:                 if (document.forms.checkselect[i].checked){
1.54      banghart  440:                     fileList = fileList + document.forms.checkselect.currentpath.value + document.forms.checkselect[i].value + "," ;
1.49      banghart  441:                 }
                    442:             }
                    443:             opener.document.forms.lonhomework.
                    444: ENDSMP
1.82      albertel  445:     $javascript .= $env{'form.fieldname'};
1.63      banghart  446:     $javascript .= (<<ENDSMP);
1.49      banghart  447:         .value=fileList;
1.48      banghart  448:             self.close();
                    449:         }
                    450:         </script>
                    451: ENDSMP
1.63      banghart  452:     $r->print($javascript);
1.47      banghart  453:     $r->print("<h1>Select portfolio files</h1>
1.88      albertel  454:                 Check as many as you wish in response to the problem.<br />");
                    455:     my @otherfiles=&Apache::lonnet::files_not_in_path($env{'user.name'}, $env{'form.currentpath'});
                    456:     if (@otherfiles) {
                    457: 	$r->print("<strong>Files selected from other directories:</strong><br />");
                    458: 	foreach my $file (@otherfiles) {
                    459: 	    $r->print($file."<br />");
                    460: 	}
1.60      banghart  461:     }
1.47      banghart  462: }
1.24      albertel  463: sub upload {
1.94      raeburn   464:     my ($r,$url,$group)=@_;
1.82      albertel  465:     my $fname=$env{'form.uploaddoc.filename'};
                    466:     my $filesize = (length($env{'form.uploaddoc'})) / 1000; #express in k (1024?)
1.38      banghart  467:     my $disk_quota = 20000; # expressed in k
1.34      banghart  468:     $fname=&Apache::lonnet::clean_filename($fname);
1.94      raeburn   469: 
                    470:     my $portfolio_root=&get_portfolio_root($group);
                    471:     my ($uname,$udom) = &get_name_dom($group);
                    472:     my $port_path = &get_port_path($group);
1.38      banghart  473:     # Fixme --- Move the checking for existing file to LOND error return
1.94      raeburn   474:     my @dir_list=&get_dir_list($portfolio_root,$group);
1.34      banghart  475:     my $found_file = 0;
1.76      banghart  476:     my $locked_file = 0;
1.33      banghart  477:     foreach my $line (@dir_list) {
1.76      banghart  478:         my ($file_name)=split(/\&/,$line,2);
                    479:         if ($file_name eq $fname){
1.33      banghart  480:             $found_file = 1;
1.94      raeburn   481:             if (&Apache::lonnet::is_locked($env{'form.currentpath'}.$file_name,$udom,$uname) eq 'true') {
1.76      banghart  482:                 $locked_file = 1;
                    483:             } 
1.33      banghart  484:         }
                    485:     }
1.94      raeburn   486:     my $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$portfolio_root);
1.87      albertel  487:     if (($current_disk_usage + $filesize) > $disk_quota){
1.86      albertel  488:         $r->print('<font color="red">Unable to upload <strong>'.$fname.' (size = '.$filesize.' kilobytes)</strong>. Disk quota will be exceeded.'.
1.38      banghart  489:                   '<br />Disk quota is '.$disk_quota.' kilobytes. Your current disk usage is '.$current_disk_usage.' kilobytes.');
1.94      raeburn   490:         $r->print(&done('Back',$url,$group));
1.38      banghart  491:     } 
1.76      banghart  492:     elsif ($found_file){
                    493:         if ($locked_file){
1.94      raeburn   494:             $r->print('<font color="red">Unable to upload <strong>'.$fname.'</strong>, a <strong>locked</strong> file by that name was found in <strong>'.$port_path.$env{'form.currentpath'}.'</strong></font>'.
1.76      banghart  495:                   '<br />You will be able to rename or delete existing '.$fname.' after a grade has been assigned.');
1.94      raeburn   496:             $r->print(&done('Back',$url,$group));      
1.76      banghart  497:         } else {   
1.94      raeburn   498:             $r->print('<font color="red">Unable to upload <strong>'.$fname.'</strong>, a file by that name was found in <strong>'.$port_path.$env{'form.currentpath'}.'</strong></font>'.
                    499:                   '<br />To upload, rename or delete existing '.$fname.' in '.$port_path.$env{'form.currentpath'});
                    500:             $r->print(&done('Back',$url,$group));
1.76      banghart  501:         }
1.33      banghart  502:     } else {
                    503:         my $result=&Apache::lonnet::userfileupload('uploaddoc','',
1.94      raeburn   504: 	        	 $port_path.$env{'form.currentpath'});
1.33      banghart  505:         if ($result !~ m|^/uploaded/|) {
1.34      banghart  506:             $r->print('<font color="red"> An errror occured ('.$result.
                    507: 	              ') while trying to upload '.&display_file().'</font><br />');
1.94      raeburn   508: 	    $r->print(&done('Back',$url,$group));
1.76      banghart  509:         } else {
1.94      raeburn   510:             $r->print(&done(undef,$url,$group));
1.33      banghart  511:         }
1.25      albertel  512:     }
                    513: }
1.80      banghart  514: sub lock_info {
1.94      raeburn   515:     my ($r,$url,$group) = @_;
                    516:     my ($uname,$udom) = &get_name_dom($group);
                    517:     my %current_permissions = &Apache::lonnet::dump('file_permissions',$udom,$uname);
1.84      banghart  518:     my $file_name = $env{'form.lockinfo'};
1.85      banghart  519:     foreach my $key(keys(%current_permissions)) {
1.84      banghart  520:         if ($file_name eq $key) {
1.85      banghart  521:             foreach my $array_item (@{$current_permissions{$key}}) {
                    522:                 if (ref($array_item)) {
                    523:                     $r->print('<strong>'.$key.'</strong> was submitted in response to problem: <strong>'.
                    524:                             &Apache::lonnet::gettitle($$array_item[0]).'</strong><br />');
                    525:                     my %course_description = &Apache::lonnet::coursedescription($$array_item[1]);
                    526:                     $r->print('In the course: <strong>'.$course_description{'description'}.'</strong><br />');
                    527:                     # $r->print('the third is '.$$array_item[2].'<br>');
                    528:                     # $r->print("item is $$array_item[0]<br> and $$array_item[0]");
                    529:                 }
                    530:             }
1.84      banghart  531:         }    
                    532:     }
1.94      raeburn   533:     $r->print(&done('Back',$url,$group));
1.80      banghart  534:     return 'ok';
                    535: }
1.25      albertel  536: sub createdir {
1.94      raeburn   537:     my ($r,$url,$group)=@_;
1.82      albertel  538:     my $newdir=&Apache::lonnet::clean_filename($env{'form.newdir'});
1.28      albertel  539:     if ($newdir eq '') {
1.37      banghart  540:     	$r->print('<font color="red">'.
                    541: 	    	  &mt("Error: no directory name was provided.").
                    542: 		      '</font><br />');
1.94      raeburn   543: 	    $r->print(&done(undef,$url,$group));
1.37      banghart  544: 	    return;
1.94      raeburn   545:     }
                    546:     my $portfolio_root = &get_portfolio_root($group); 
                    547:     my @dir_list=&get_dir_list($portfolio_root,$group);
1.37      banghart  548:     my $found_file = 0;
                    549:     foreach my $line (@dir_list) {
                    550:         my ($filename)=split(/\&/,$line,2);
                    551:         if ($filename eq $newdir){
                    552:             $found_file = 1;
                    553:         }
                    554:     }
                    555:     if ($found_file){
                    556:     	    $r->print('<font color="red"> Unable to create a directory named <strong>'.$newdir.
                    557:     	            ' </strong>a file or directory by that name already exists.</font><br />');
                    558:     } else {
1.94      raeburn   559:         my ($uname,$udom) = &get_name_dom($group);
                    560:         my $port_path = &get_port_path($group);
                    561:         my $result=&Apache::lonnet::mkdiruserfile($uname,$udom,
                    562: 	         $port_path.$env{'form.currentpath'}.$newdir);
1.37      banghart  563:         if ($result ne 'ok') {
                    564:     	    $r->print('<font color="red"> An errror occured ('.$result.
                    565: 	    	      ') while trying to create a new directory '.&display_file().'</font><br />');
                    566:         }
1.24      albertel  567:     }
1.82      albertel  568:     if ($newdir ne $env{'form.newdir'}) {
                    569:         $r->print("The new directory name was changed from:<br /><strong>".$env{'form.newdir'}."</strong> to <strong>$newdir </strong>");  
1.67      banghart  570:     }
1.94      raeburn   571:     $r->print(&done(undef,$url,$group));
                    572: }
                    573: 
                    574: sub get_portfolio_root {
                    575:     my ($group) = @_;
                    576:     my ($portfolio_root,$udom,$uname,$path);
                    577:     ($uname,$udom) = &get_name_dom($group);
                    578:     if (defined($group)) {
                    579:         $path = '/userfiles/groups/'.$group.'/portfolio';
                    580:     } else {
                    581:         $path = '/userfiles/portfolio';
                    582:     }
                    583:     return (&Apache::loncommon::propath($udom,$uname).$path);
                    584: }
                    585: 
                    586: sub get_dir_list {
                    587:     my ($portfolio_root,$group) = @_;
                    588:     my ($uname,$udom) = &get_name_dom($group);
                    589:     return &Apache::lonnet::dirlist($env{'form.currentpath'},
                    590:                                           $udom,$uname,$portfolio_root);
                    591: }
                    592: 
                    593: sub get_name_dom {
                    594:     my ($group) = @_;
                    595:     my ($uname,$udom);
                    596:     if (defined($group)) {
                    597:         $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    598:         $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
                    599:     } else {
                    600:         $udom = $env{'user.domain'};
                    601:         $uname = $env{'user.name'};
                    602:     }
                    603:     return ($uname,$udom);
                    604: }
                    605: 
                    606: sub get_namespace {
                    607:     my ($group) = @_;
                    608:     my $namespace = 'portfolio';
                    609:     if (defined($group)) {
                    610:         my ($uname,$udom) = &get_name_dom($group);
                    611:         $namespace .= '_'.$udom.'_'.$uname.'_'.$group;
                    612:     }
                    613:     return $namespace;
                    614: }
                    615: 
                    616: sub get_port_path {
                    617:     my ($group) = @_;
                    618:     my $port_path;
                    619:     if (defined($group)) {
                    620:        $port_path = "groups/$group/portfolio";
                    621:     } else {
                    622:        $port_path = 'portfolio';
                    623:     }
                    624:     return $port_path;
1.24      albertel  625: }
                    626: 
                    627: sub handler {
                    628:     # this handles file management
                    629:     my $r = shift;
1.73      banghart  630:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.94      raeburn   631:          ['selectfile','currentpath','meta','lockinfo','currentfile',
                    632: 	    'action','fieldname','mode','rename','continue','group']);
                    633:     my ($uname,$udom,$portfolio_root,$url,$group,$caller,$title);
                    634:     if ($r->uri =~ m|^(/adm/)([^/]+)|) {
                    635:         $url = $1.$2;
                    636:         $caller = $2;
                    637:     }
                    638:     if ($caller eq 'coursegrp_portfolio') {
                    639:     #  Needs to be in a course
                    640:         if (! ($env{'request.course.fn'})) {
                    641:         # Not in a course
                    642:             $env{'user.error.msg'}=
                    643:      "/adm/coursegrp_portfolio:rgf:0:0:Cannot view group portfolio";
                    644:             return HTTP_NOT_ACCEPTABLE;
                    645:         }
                    646:         my $earlyout = 0;
                    647:         my $view_permission = &Apache::lonnet::allowed('vcg',
                    648:                                                 $env{'request.course.id'});
                    649:         $group = $env{'form.group'};
                    650:         $group =~ s/\W//g;
                    651:         if ($group) {
                    652:             ($uname,$udom) = &get_name_dom($group);
1.99      raeburn   653:             my %curr_groups = &Apache::longroup::coursegroups($udom,$uname,
1.98      albertel  654: 							       $group); 
                    655:             if (%curr_groups) {
1.94      raeburn   656:                 if (($view_permission) || (&Apache::lonnet::allowed('rgf',
                    657:                                       $env{'request.course.id'}.'/'.$group))) {
                    658:                     $portfolio_root = &get_portfolio_root($group);
                    659:                 } else {
                    660:                     $r->print('You do not have the privileges required to access the shared files space for this group');
                    661:                     $earlyout = 1;
                    662:                 }
                    663:             } else {
                    664:                 $r->print('Not a valid group for this course');
                    665:                 $earlyout = 1;
                    666:             }
                    667:             $title = &mt('Group files').' for '.$group; 
                    668:         } else {
                    669:             $r->print('Invalid group');
                    670:             $earlyout = 1;
                    671:         }
                    672:         if ($earlyout) { return OK; }
                    673:     } else {
                    674:         ($uname,$udom) = &get_name_dom();
                    675:         $portfolio_root = &get_portfolio_root();
                    676:         $title = &mt('Portfolio Manager');
                    677:     }
                    678: 
1.24      albertel  679:     &Apache::loncommon::no_cache($r);
                    680:     &Apache::loncommon::content_type($r,'text/html');
                    681:     $r->send_http_header;
                    682:     # Give the LON-CAPA page header
1.82      albertel  683:     if ($env{"form.mode"} eq 'selectfile'){
1.96      albertel  684:         $r->print(&Apache::loncommon::start_page($title,undef,
1.97      albertel  685: 						 {'only_body' => 1}));
1.74      banghart  686:     } else {
1.97      albertel  687:         $r->print(&Apache::loncommon::start_page($title));
1.74      banghart  688:     }
1.24      albertel  689:     $r->rflush();
1.88      albertel  690: 	if (($env{'form.storeupl'}) & (!$env{'form.uploaddoc.filename'})){
1.40      banghart  691:    	    $r->print('<font color="red"> No file was selected to upload.'.
                    692:    	            'To upload a file, click <strong>Browse...</strong>'.
                    693:    	            ', select a file, then click <strong>Upload</strong>,</font>');
                    694: 	}
1.82      albertel  695:     if ($env{'form.meta'}) {
1.94      raeburn   696:         &open_form($r,$url);
1.82      albertel  697: #        $r->print(&edit_meta_data($r, $env{'form.currentpath'}.$env{'form.selectfile'}));
1.70      banghart  698:         $r->print('Edit the meta data<br />');
1.94      raeburn   699:         &close_form($r,$url,$group);
1.70      banghart  700:     }
1.82      albertel  701:     if ($env{'form.store'}) {
1.70      banghart  702:     }
                    703: 
1.82      albertel  704:     if ($env{'form.uploaddoc.filename'}) {
1.94      raeburn   705: 	&upload($r,$url,$group);
1.82      albertel  706:     } elsif ($env{'form.action'} eq 'delete' && $env{'form.confirmed'}) {
1.94      raeburn   707: 	&delete_confirmed($r,$url,$group);
1.82      albertel  708:     } elsif ($env{'form.action'} eq 'delete') {
1.94      raeburn   709: 	&delete($r,$url,$group);
1.82      albertel  710:     } elsif ($env{'form.action'} eq 'deletedir' && $env{'form.confirmed'}) {
1.94      raeburn   711: 	&delete_dir_confirmed($r,$url,$group);
1.82      albertel  712:     } elsif ($env{'form.action'} eq 'deletedir'){
1.94      raeburn   713: 	&delete_dir($r,$url,$group);
1.82      albertel  714:     } elsif ($env{'form.action'} eq 'rename' && $env{'form.confirmed'}) {
1.94      raeburn   715: 	&rename_confirmed($r,$url,$group);
1.82      albertel  716:     } elsif ($env{'form.rename'}) {
                    717:         $env{'form.selectfile'} = $env{'form.rename'};
                    718:         $env{'form.action'} = 'rename';
1.94      raeburn   719: 	&rename($r,$url,$group);
1.82      albertel  720:     } elsif ($env{'form.createdir'}) {
1.94      raeburn   721: 	&createdir($r,$url,$group);
1.82      albertel  722:     } elsif ($env{'form.lockinfo'}) {
1.94      raeburn   723:         &lock_info($r,$url,$group);
1.24      albertel  724:     } else {
                    725: 	my $current_path='/';
1.82      albertel  726: 	if ($env{'form.currentpath'}) {
                    727: 	    $current_path = $env{'form.currentpath'};
1.24      albertel  728: 	}
1.94      raeburn   729:         my @dir_list=&get_dir_list($portfolio_root,$group);
1.46      albertel  730: 	if ($dir_list[0] eq 'no_such_dir'){
                    731: 	    # two main reasons for this:
                    732:             #    1) never been here, so directory structure not created
                    733: 	    #    2) back-button navigation after deleting a directory
                    734: 	    if ($current_path eq '/'){
1.100   ! albertel  735: 	        &Apache::lonnet::mkdiruserfile($uname,$udom,
        !           736: 					       &get_port_path($group));
1.46      albertel  737: 	    } else {
                    738:                 # some directory that snuck in get rid of the directory
                    739:                 # from the recent pulldown, just in case
                    740: 		&Apache::lonhtmlcommon::remove_recent('portfolio',
                    741: 						      [$current_path]);
                    742: 		$current_path = '/'; # force it back to the root        
                    743: 	    }
                    744: 	    # now grab the directory list again, for the first time
                    745: 	    @dir_list=&Apache::lonnet::dirlist($current_path,
1.94      raeburn   746: 					    $udom,$uname,$portfolio_root);
1.43      banghart  747:         }
1.46      albertel  748: 	# need to know if directory is empty so it can be removed if desired
                    749: 	my $is_empty=(@dir_list == 2);
1.94      raeburn   750: 	&display_common($r,$url,$current_path,$is_empty,\@dir_list,$group);
                    751:         &display_directory($r,$url,$current_path,$is_empty,\@dir_list,$group);
1.95      albertel  752: 	$r->print(&Apache::loncommon::end_page());
1.30      banghart  753:     }
1.90      albertel  754:     return OK;
1.2       banghart  755: }
1.1       banghart  756: 1;
                    757: __END__

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