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

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.16      banghart   32: 
                     33: # receives a file name and path stub from username/userfiles/portfolio/
                     34: # returns an anchor tag consisting encoding filename and currentpath
1.10      banghart   35: sub makeAnchor{
1.8       albertel   36:     my ($fileName, $currentPath) = @_;
                     37:     my $anchor = '<a href="/adm/portfolio?selectfile='.$fileName.'&currentpath='.$currentPath.'">'.$fileName.'</a>';
                     38:     return $anchor;
1.6       banghart   39: }
1.16      banghart   40: 
                     41: # returns html with <br /> separated contents of the directory
                     42: # returns a <strong>currentFile</strong> (bolds the selected file/dir)
1.6       banghart   43: sub displayDirectory {
1.16      banghart   44:     my ($currentPath, $currentFile, @dirList,) = @_;
1.10      banghart   45:     my $displayOut='';  
1.8       albertel   46:     my $fileName;
                     47:     my $upPath;
1.10      banghart   48:     if ($currentPath ne '/'){
                     49:         $displayOut = 'Listing of '.$currentPath.'<br /><hr />'.
                     50:         # provides the "up one directory level" function
                     51:         # it means shortening the currentpath to the parent directory
                     52:         $currentPath =~ m:(^/.*)(/.*/$):;
                     53:         if ($1 ne '/'){
                     54:             $upPath = $1.'/';
                     55:         }else{
                     56:             $upPath = $1;
                     57:         }
                     58:         
1.17    ! banghart   59:         # $displayOut = $displayOut.'<a href="/adm/portfolio?selectfile='.$upPath.'&currentpath='.$upPath.'">..</a><br />';
1.8       albertel   60:     } else {
1.17    ! banghart   61:         # $displayOut = $displayOut.'at root '.$currentPath.'<br />';
1.8       albertel   62:     }
1.10      banghart   63:     foreach my $line (@dirList) {
                     64:     	#$strip holds directory/file name
                     65:     	#$dom 
1.17    ! banghart   66:     	my ($fileName,$dom,undef,$testdir,undef,undef,undef,undef,undef,undef,undef,undef,undef,undef,$obs,undef,$path,$debug)=split(/\&/,$line,18); 
1.16      banghart   67:     	$path =~ m:/:;
                     68:     	my $dirDepth = @-;
1.10      banghart   69:         if (($fileName ne '.') && ($fileName ne '..')){
1.16      banghart   70:           	for (my $i = 0; $i <= $dirDepth; $i += 1){
                     71:     	        $displayOut.='<blockquote>';
                     72:     	    }
1.10      banghart   73:             if ($testdir =~ m:^1:){
                     74:                 # handle directories different from files
                     75:                 if ($fileName eq $currentFile){ #checks to bold the selected file
1.17    ! banghart   76:                     $displayOut.= $debug.'<strong>'.(makeAnchor($fileName.'/', $path.$fileName.'/').'</strong><br />'."\n");
1.10      banghart   77:                 }else{
1.17    ! banghart   78:                     $displayOut.= $debug.(makeAnchor($fileName.'/', $path.$fileName.'/').'<br />'."\n");
1.10      banghart   79:                 }
                     80:             }else{
                     81:                 if ($fileName eq $currentFile){ #checks to bold the selected file
1.17    ! banghart   82:                     $displayOut.=$debug.'<strong>'.(makeAnchor($fileName, $currentPath).'</strong><br />'."\n");
1.10      banghart   83:                 }else{
1.17    ! banghart   84:                     $displayOut.=$debug.(makeAnchor($fileName, $currentPath).'<br />'."\n");
1.10      banghart   85:                 }
                     86:             }
1.16      banghart   87:         	for (my $i = 0; $i <= $dirDepth; $i += 1){
                     88:         	    $displayOut.='</blockquote>';
                     89:     	    }
                     90:             
1.10      banghart   91:         }
                     92:     	
1.8       albertel   93:     }
                     94:     return $displayOut;
1.6       banghart   95: }
                     96: sub displayActions {
1.10      banghart   97:     # returns html to offer user appropriate actions depending on selected file/directory
1.8       albertel   98:     my $displayOut;
1.16      banghart   99:     my ($currentPath, $currentFile, $isEmpty) = @_;
1.8       albertel  100: #   $displayOut = 'here are actions for '.$currentFile;
1.10      banghart  101:     if ($currentFile =~ m:/$:){
                    102:         # if the selected file is a directory, these are the options
                    103:         # offer the chance to delete the directory only if it is empty
                    104:         if ($isEmpty && ($currentPath ne '/')) {
                    105:             $displayOut =   $displayOut.'<form method="POST">
                    106:             <input type="hidden" name="selectfile" 
                    107:             value="'.$currentFile.'" />
                    108:             <input type="hidden" name="fileaction" value="delete" /> 
                    109:             <input type="hidden" name="currentpath" value="'.$currentPath.'" /> 
                    110:             <center>
                    111:             <input type="submit" 
                    112:             value="Delete '.$currentFile.'" />
                    113:             </center>
                    114:             </form>';
                    115:         } 
                    116:         if ($currentPath ne '/') {
                    117:             $displayOut = $displayOut.'<hr />
                    118:             <form method="POST">
                    119:             <input type="hidden" name="selectfile" 
                    120:             value="'.$currentFile.'" />
                    121:             <input type="hidden" name="fileaction" value="rename" /> 
                    122:             <input type="hidden" name="currentpath" value="'.$currentPath.'" /> 
                    123:             <input type="input" name="filenewname" value="Type new name here" /> 
                    124:             <input type="submit" 
                    125:             value="Rename '.$currentFile.'" />
                    126:             </form>';
                    127:         }
                    128:     }else{  #action options offered for files
                    129:         $displayOut = $displayOut.'<form method="POST">';
                    130:         $displayOut = $displayOut.'<input type="hidden" name="selectfile"';
                    131:         $displayOut = $displayOut.'value="'.$currentFile;
                    132:         $displayOut = $displayOut.'" /><input type="hidden" name="fileaction" value="delete" /> 
                    133:         <input type="hidden" name="currentpath" value="'.$currentPath.'" /> 
                    134:         <center>
                    135:         <input type="submit"
                    136:         value="Delete '.$currentFile.'" />
                    137:         </center>
                    138:         </form>';
                    139:     
                    140:         $displayOut = $displayOut.'<hr />
                    141:         <form method="POST">
                    142:         <input type="hidden" name="selectfile" 
                    143:         value="'.$currentFile.'" />
                    144:         <input type="hidden" name="fileaction" value="rename" /> 
                    145:         <input type="hidden" name="currentpath" value="'.$currentPath.'" /> 
                    146:         <input type="input" name="filenewname" value="Type new name here" /> 
                    147:         <input type="submit" 
                    148:         value="Rename '.$currentFile.'" />
                    149:         </form>
                    150:         <hr />';
1.8       albertel  151:     }
1.10      banghart  152:     $displayOut = $displayOut.'<hr />Add a file to '.$currentPath;
1.8       albertel  153:     # file upload form 
                    154:     $displayOut = $displayOut.'<form method="post" enctype="multipart/form-data">';
1.9       albertel  155:     $displayOut = $displayOut.'<input name="uploaddoc" type="file" />'.
1.10      banghart  156:         '<input type="hidden" name="currentpath" value="'.$currentPath.'" />'.
                    157:         '<input type="submit" name="storeupl" value="Upload" />'.
                    158:         '</form><hr />';
1.8       albertel  159:     $displayOut = $displayOut.'<form method="POST">
1.10      banghart  160:         <input name="subdir" type="text" />
                    161:         <input type="submit" value="Create Subdirectory" />
                    162:         </form>
                    163:             ';
1.8       albertel  164:     return $displayOut;
1.6       banghart  165: }
1.1       banghart  166: sub handler {
1.8       albertel  167:     # this handles file management
1.10      banghart  168:     my $r = shift;
1.8       albertel  169:     my @dirList; # will hold directory listing as array
                    170:     my $udir; # returned from home server
                    171:     my $currentPath; # path assuming /userfiles/portfolio/ as root
                    172:     my $currentFile; # directory or file contained in $pathToRoot.$currentPath
                    173:     my $action; # delete, rename, makedirectory, removedirectory,
                    174:     my $filenewname; # for rename action (guess what we do with it!)
                    175:     my $isFile;
1.10      banghart  176:     my $isEmpty;
                    177:     &Apache::loncommon::no_cache($r);
1.14      banghart  178:     &Apache::loncommon::content_type($r,'text/html');
1.8       albertel  179:     $r->send_http_header;
1.14      banghart  180:     # Give the LON-CAPA page header
                    181:     $r->print('<html><head><title>'.
                    182:               &mt('Portfolio Manager').
                    183:               "</title></head>\n".
                    184:               &Apache::loncommon::bodytag('Portfolio Manager'));
                    185:     $r->rflush();
1.8       albertel  186:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.10      banghart  187:                                             ['selectfile','currentpath', 'currentfile']);
1.8       albertel  188:     # currentPath and currentFile need to be set for the rest of things to happen
                    189:     # sometimes, currentFile will be passed by a form field, selectedfile
                    190:     # if there is no 'form.selectedfile' then the current directory is 
                    191:     # considered as selected 
1.11      banghart  192:     if ($ENV{'form.currentpath'}) {
1.10      banghart  193:         $currentPath = $ENV{'form.currentpath'};
1.11      banghart  194:     } else {
1.10      banghart  195:         $currentPath = '/';
1.8       albertel  196:     }
1.11      banghart  197:     if ($ENV{'form.selectfile'}) {
1.10      banghart  198:         # have to check if the selected file is a subdirectory
                    199:         if ($ENV{'form.selectfile'} =~ /-\(Dir\)/){
                    200:             # $currentPath =~ /\-\(Dir\)/;
                    201:             $currentPath = $`.'/';
                    202:             $r->print('<br />'.$currentPath.'<br />');
                    203:         }
                    204:         $currentFile = $ENV{'form.selectfile'};
1.11      banghart  205:     } else {
1.10      banghart  206:         $currentFile = '';
1.8       albertel  207:     }
                    208:     # if we're uploading a file, we need to do it early so it will show in the directory list
1.11      banghart  209:     if ($ENV{'form.uploaddoc.filename'}) {
                    210:         $r->print($ENV{'form.storeupl'}.'<br />');
                    211:         $r->print(&Apache::lonnet::userfileupload('uploaddoc','','portfolio'.$currentPath).'<br />');  
1.8       albertel  212:     }
                    213:     # similarly, we need to delete or rename files before getting directory list
1.10      banghart  214:     if ($ENV{'form.selectfile'}){
1.11      banghart  215:         if ($ENV{'form.fileaction'} eq 'delete') {
1.10      banghart  216:             $r->print('<br />trying to delete '.$currentPath.$ENV{'form.selectfile'}.'<br />');
                    217:             $r->print(&Apache::lonnet::removeuserfile($ENV{'user.name'}, $ENV{'user.domain'},'portfolio'.$currentPath.$ENV{'form.selectfile'}));
                    218:             $currentFile = '';
1.11      banghart  219:         } elsif ($ENV{'form.fileaction'} eq 'rename') {
1.10      banghart  220:             &Apache::lonnet::portfoliomanage($currentPath.$ENV{'form.selectfile'}, 'rename', $currentPath.$ENV{'form.filenewname'} );
                    221:         }
1.8       albertel  222:     }
                    223:     # we always need $dirList, plus this will return information about the current file
                    224:     # as well as information about he home server directory structure, specifically
1.10      banghart  225:     # the path to the users userfiles directory.    
1.16      banghart  226:     # 
1.15      albertel  227:     my $portfolio_root = &Apache::loncommon::propath($ENV{'user.domain'},
                    228: 						     $ENV{'user.name'}).
                    229: 						       '/userfiles/portfolio';
1.16      banghart  230:     my $done = 0;
                    231:     my $subdir = '';
                    232:     my @workinglist; # intermediate array, holds directory listing lines (dirlist), and path information
                    233:     my $readDirectory = 1; # flag for directory
                    234:     my $loopCounter = 0; # needed only for development to prevent run away program (or maybe more?)
                    235:     while (!$done){
                    236:         # Needed while developing. Later, too?
                    237:         $loopCounter += 1;
                    238:         if ($loopCounter > 50) {
                    239:             $r->print('<br />stop runaway');
                    240:             return OK;
                    241:         }
                    242:         # ---
                    243:         if ($readDirectory){ # is true the first time through, then true if dirlist line is a subdir
                    244:             # $r->print('<br />reading '.$portfolio_root.$subdir);
                    245:             my @list = &Apache::lonnet::dirlist($currentPath,  $ENV{'user.domain'}, $ENV{'user.name'}, $portfolio_root.$subdir);
1.17    ! banghart  246:             $r->print('value in @list = '.@list);
        !           247:             for (my $i = 0; $i <= @list; $i++ ){
        !           248:                 my $line = pop @list;
        !           249:                 $line = $line.'&'.$subdir.'&'.$loopCounter; # append the subdirectory information and loopcounter for debug
1.16      banghart  250:                 my ($fileName,$dom,undef,$testdir,undef,undef,undef,undef,undef,undef,undef,undef,undef,undef,$obs,undef,$subpath)=split(/\&/,$line,17); 
                    251:                 if (($fileName ne '.') && ($fileName ne '..')){ # we throw away the current and parent directories
1.17    ! banghart  252:                     $r->print('<br />'.$line); #for debugging
        !           253:                     unshift @workinglist, $line; # add the line to the working list array
        !           254:                     
        !           255:                 }else{
        !           256:                     $r->print('<br /> parent or current '.$line); #for debugging
1.16      banghart  257:                 }
                    258:             }
                    259:         }
1.17    ! banghart  260:         $r->print('<br />'.@workinglist.' lines in workinglist');
1.16      banghart  261:         my $line = shift @workinglist; #take one off the working list
1.17    ! banghart  262:         $r->print('<br />'.@workinglist.' lines in workinglist');
1.16      banghart  263:         if ($line eq '') { # if the working list is empty
                    264:             $done = 1;
                    265:         }else{
1.17    ! banghart  266:             my ($fileName,$dom,undef,$testdir,undef,undef,undef,undef,undef,undef,undef,undef,undef,undef,$obs,undef,$subpath,$debug)=split(/\&/,$line,18); 
        !           267:             $r->print('<br />'.$fileName.' is '.$testdir);
1.16      banghart  268:             push @dirList, $line; # and put it in the display list
                    269:             if ($testdir =~ m:^1:) { # true if this is a directory
                    270:                 # $r->print('<br />added subdir '.$fileName);
                    271:                 $subdir = $subpath.'/'.$fileName; 
                    272:                 $readDirectory = 1;
                    273:             }else{
                    274:                 $readDirectory = 0;
                    275:             }
                    276:         }
                    277:     }
                    278:     #	if item is directory {  get the next level down
                    279:     #		my @list = &Apache::lonnet::dirlist($currentPath,  $ENV{'user.domain'}, $ENV{'user.name'}, $portfolio_root.$);
                    280:     
1.12      banghart  281:     if (@dirList == 2) { # need to know if directory is empty so it can be removed if desired
1.10      banghart  282:         $isEmpty = 1;
1.13      banghart  283:     } else {
1.10      banghart  284:         $isEmpty = 0;
                    285:     }
1.16      banghart  286:    
1.11      banghart  287:     if ($ENV{'form.selectfile'}) {
                    288:         if ($ENV{'form.fileaction'} eq 'delete') {
1.10      banghart  289:             &Apache::lonnet::portfoliomanage($ENV{'form.selectfile'}, 'delete', undef );
                    290:             $ENV{'portfolio.file'} = 'Selected File Deleted';
1.11      banghart  291:         } elsif ($ENV{'form.fileaction'} eq 'rename') {
                    292:             &Apache::lonnet::portfoliomanage($ENV{'form.selectfile'}, 'rename', $ENV{'form.filenewname'});
                    293:         } else {
1.10      banghart  294:         # Remember user's file selection for later
                    295:         $ENV{'portfolio.file'} = $ENV{'form.selectfile'};
                    296:         # offer things user can do with selected file
                    297:         }
                    298:     }else{
                    299:         unless ($ENV{'portfolio.file'}){
                    300:             $ENV{'portfolio.file'} = 'No File Selected';
                    301:         }
1.8       albertel  302:     }
                    303:     ##############################
                    304:     #
                    305:     # Display begins here
                    306:     #
                    307:     ##############################
1.11      banghart  308:     $r->print('<table border=1><tr><td>');
1.16      banghart  309:     $r->print(displayDirectory($currentPath, $currentFile, @dirList));
1.11      banghart  310:     $r->print('</td>><td>');
1.16      banghart  311:     $r->print(displayActions($currentPath, $currentFile, $isEmpty));
1.11      banghart  312:     $r->print('</td>></tr></table>');
1.14      banghart  313:     $r->print('</blockquote>');
                    314:     $r->print("</body>\n</html>\n");
                    315:     $r->rflush();
1.8       albertel  316:     return OK;
1.2       banghart  317: }
1.1       banghart  318: 
                    319: 1;
                    320: __END__

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