View of /trunk/webwork2/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/ScoringDownload.pm,v 1.3 2004/03/28 03:25:47 gage Exp $
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 package WeBWorK::ContentGenerator::Instructor::ScoringDownload;
   18 use base qw(WeBWorK::ContentGenerator::Instructor);
   19 
   20 =head1 NAME
   21 
   22 WeBWorK::ContentGenerator::Instructor::ScoringDownload - Download scoring data files
   23 
   24 =cut
   25 
   26 use strict;
   27 use warnings;
   28 use Apache::Constants qw(:common);
   29 
   30 sub header {
   31   my ($self)     = @_;
   32   my $r          = $self->r;
   33   my $ce         = $r->ce;
   34   my $scoringDir = $ce->{courseDirs}->{scoring};
   35   my $file       = $r->param('getFile');
   36   if (-f "$scoringDir/$file") {
   37     $r->content_type('text/comma-separated-values');
   38     $r->header_out("Content-Disposition" => "attachment; filename=$file;");
   39     $r->send_http_header();
   40     return OK;
   41   } else {
   42     $self->{noContent} = 1;
   43     return NOT_FOUND;
   44   }
   45 }
   46 
   47 sub content {
   48   my ($self)     = @_;
   49   my $r          = $self->r;
   50   my $ce         = $r->ce;
   51   my $authz      = $r->authz;
   52   my $scoringDir = $ce->{courseDirs}->{scoring};
   53   my $user       = $r->param('user');
   54 
   55   if (!$authz->hasPermissions($user, "score_sets")) {
   56     print "You do not have permission to access scoring data";
   57   } else {
   58     my $file = $r->param('getFile');
   59     open my $fh, "<", "$scoringDir/$file";
   60     print while (<$fh>);
   61     close $fh;
   62   }
   63 }
   64 
   65 1;