loncom/interface/multidownload.pl - view

File: [LON-CAPA] / loncom / interface / multidownload.pl
Revision 1.37: download - view: text, annotated - select for diffs
Tue Feb 5 06:51:55 2008 UTC (16 years, 3 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_7_X, version_2_7_99_0, version_2_7_1, version_2_7_0, version_2_6_X, version_2_6_99_1, version_2_6_99_0, version_2_6_3, version_2_6_2, HEAD

- Remove duplicte line.

1: #!/usr/bin/perl 2: # CGI-script to allow download of all essay submissions of 3: # multiple students. 4: # 5: # $Id: multidownload.pl,v 1.37 2008/02/05 06:51:55 raeburn Exp $ 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: 29: use lib '/home/httpd/lib/perl'; 30: use LONCAPA::loncgi; 31: use File::Path; 32: use File::Basename; 33: use File::Copy; 34: use Apache::lonhtmlcommon(); 35: use Apache::lonnavmaps(); 36: use Apache::loncommon(); 37: use Apache::lonlocal; 38: use Apache::lonmsg(); 39: use Apache::lonnet; 40: use LONCAPA::Enrollment; 41: use strict; 42: 43: sub is_flat { 44: my ($partlist, $res) = @_; 45: my $flat_part = 1; 46: my $flat_resp = 1; 47: if (scalar(@$partlist) > 1) { 48: $flat_part = 0; 49: } 50: foreach my $partid (@$partlist) { 51: my @ids = $res->responseIds($partid); 52: if (scalar(@ids) > 1 ) { 53: $flat_resp = 0; 54: } 55: } 56: return ($flat_part, $flat_resp); 57: } 58: 59: 60: sub get_part_resp_path { 61: my ($flat_part, $flat_resp, $part_id, $resp_id) = @_; 62: my $part_resp_path = ""; 63: if (!$flat_part) { 64: $part_resp_path = "part$part_id/"; 65: } 66: if (!$flat_resp) { 67: $part_resp_path .= "resp$resp_id/"; 68: } 69: $part_resp_path =~ s/\/^//; 70: return('/'.$part_resp_path); 71: } 72: 73: 74: $|=1; 75: if (! &LONCAPA::loncgi::check_cookie_and_load_env()) { 76: print <<END; 77: Content-type: text/html 78: 79: <html> 80: <head><title>Bad Cookie</title></head> 81: <body> 82: Your cookie information is incorrect. 83: </body> 84: </html> 85: END 86: return; 87: } 88: 89: &Apache::lonlocal::get_language_handle(); 90: &Apache::loncommon::content_type(undef,'text/html'); 91: my $identifier = $ENV{'QUERY_STRING'}; 92: my $unique_path = $identifier.time(); 93: print(&Apache::loncommon::start_page('Multiple Downloads')); 94: 95: 96: my $scope = $env{'request.course.id'}; 97: if ($env{'request.course.sec'}) { 98: $scope .= '/'.$env{'request.course.sec'}; 99: } 100: if (&Apache::lonnet::allowed('vgr',$scope) eq 'F') { 101: my $symb = $env{'cgi.'.$identifier.'.symb'}; 102: my $navmap = Apache::lonnavmaps::navmap->new(); 103: my $res = $navmap->getBySymb($symb); 104: my $partlist = $res->parts(); 105: my ($flat_part, $flat_resp) = &is_flat($partlist, $res); 106: my ($zipout) = ($symb =~ /^.*\/(.+)\.problem$/); 107: $zipout =~ s/\s/_/g; 108: $zipout .= "$identifier.zip"; 109: my $courseid = $env{'request.course.id'}; 110: my @stuchecked = split(/\n/,$env{'cgi.'.$identifier.'.students'}); 111: my $number_of_students = scalar(@stuchecked); 112: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin('','Processing Status', 113: 'Preparing Zip File',$number_of_students,'inline','80'); 114: my @parts = split(/\n/,$env{'cgi.'.$identifier.'.parts'}); 115: my $doc_zip_root = $Apache::lonnet::perlvar{'lonZipDir'}; 116: my $uname = $env{'user.name'}; 117: my $udom = $env{'user.domain'}; 118: my $unique_user = $uname.":".$udom; 119: &mkpath($doc_zip_root."/zipdir/$unique_user/$unique_path",0,0700); 120: if (!open(MANIFEST, ">$doc_zip_root/zipdir/$unique_user/$unique_path/manifest.txt")) { 121: &Apache::lonnet::logthis("Problem making manifest"); 122: } 123: print MANIFEST (&mt("Zip file generated on [_1]",&Apache::lonlocal::locallocaltime(time()))."\n"); 124: print MANIFEST (&mt("Course: [_1]",$env{"course.$courseid.description"})."\n"); 125: print MANIFEST (&mt("Problem: [_1]",$res->compTitle)."\n"); 126: print MANIFEST (&mt("Files contained in this zip:")."\n"); 127: my $file_problem = 0; 128: my $current_student = 0; 129: foreach my $stu (@stuchecked) { 130: $current_student ++; 131: &Apache::lonhtmlcommon::Update_PrgWin('',\%prog_state,"Processing student $current_student of $number_of_students"); 132: my %files_saved; 133: my ($stuname,$studom,$fullname) = split(/:/,$stu); 134: my %record = &Apache::lonnet::restore($symb,$courseid,$studom,$stuname); 135: my $file_url = '/uploaded/'.$studom.'/'.$stuname.'/portfolio'; 136: print MANIFEST ($fullname."\n"); 137: 138: my $submission_count = 0; 139: foreach my $partid (@$partlist) { 140: my @ids = $res->responseIds($partid); 141: foreach my $respid (@ids) { 142: my $part_resp_path = &get_part_resp_path($flat_part,$flat_resp, $partid, $respid); 143: &mkpath($doc_zip_root."/zipdir/$unique_user/$unique_path/$stuname/$part_resp_path",0,0700); 144: foreach my $file (split(',',$record{"resource.$partid.$respid.portfiles"})) { 145: $file = $file_url.$file; 146: my ($file_name_only) = ($file =~ /^.*\/(.+$)/); 147: print MANIFEST ("\t$file_name_only (".&mt("Part [_1]",$partid). 148: ") (".&mt("Response [_1]",$respid).")"."\n"); 149: $submission_count ++; 150: &Apache::lonnet::repcopy($file); 151: my $source = &Apache::lonnet::filelocation("",$file); 152: my $destination = "$doc_zip_root/zipdir/$unique_user/$unique_path/$stuname$part_resp_path/$file_name_only"; 153: if (exists($files_saved{$destination})) { 154: # file has already been saved once 155: my ($file_name,$file_ext) = ($destination =~ /(^.*)(\..+$)/); 156: $destination = $file_name.$files_saved{$destination}.$file_ext; 157: $files_saved{$destination}++; 158: } 159: $files_saved{$destination}++; 160: if (!&copy($source,$destination)) { 161: if (!$file_problem) { 162: print(&mt("Unable to create: ")." "); 163: $file_problem = 1; 164: } 165: print("$stuname/part$partid/resp$respid/$file_name_only "); 166: } 167: } 168: } 169: } 170: if (!$submission_count) { 171: print MANIFEST ("\t".&mt("No Files Submitted")."\n"); 172: } 173: } 174: 175: &mkpath($doc_zip_root."/zipout/$unique_user",0,0700); 176: my $statement; 177: if (! -e "$doc_zip_root/zipout/$unique_user/$zipout") { 178: $statement = "cd $doc_zip_root/zipdir/$unique_user/$unique_path\n"; 179: $statement .= "zip -r $doc_zip_root/zipout/$unique_user/$zipout * > /dev/null"; 180: system($statement); 181: } else { 182: # should happen only if user reloads page 183: &Apache::lonnet::logthis("$zipout is already there"); 184: } 185: $statement = "rm -rf $doc_zip_root/zipdir/$unique_user/$unique_path"; 186: system($statement); 187: &Apache::lonhtmlcommon::Close_PrgWin('',\%prog_state); 188: print('<a href="/zipspool/zipout/'.$unique_user.'/'.$zipout.'">'. 189: &mt("Click to download").'</a> '); 190: close(MANIFEST); 191: } else { 192: print(&mt('You are not authorized to download student submissions.')); 193: } 194: 1; 195: __END__;