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

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

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