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

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

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