[system] / trunk / pg / lib / PGcore.pm Repository:
ViewVC logotype

Diff of /trunk/pg/lib/PGcore.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 6252 Revision 6280
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: pg/lib/PGcore.pm,v 1.1 2010/05/14 11:39:02 gage Exp $ 4# $CVSHeader: pg/lib/PGcore.pm,v 1.6 2010/05/25 22:47:52 gage Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 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 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 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. 9# version, or (b) the "Artistic License" which comes with this package.
15################################################################################ 15################################################################################
16package PGcore; 16package PGcore;
17 17
18use strict; 18use strict;
19BEGIN { 19BEGIN {
20 use Exporter; 20 use Exporter 'import';
21 our @EXPORT_OK = qw( not_null); 21 our @EXPORT_OK = qw(not_null);
22} 22}
23our $internal_debug_messages = []; 23our $internal_debug_messages = [];
24
24 25
25use PGanswergroup; 26use PGanswergroup;
26use PGresponsegroup; 27use PGresponsegroup;
27use PGrandom; 28use PGrandom;
28use PGalias; 29use PGalias;
29use PGloadfiles; 30use PGloadfiles;
30use WeBWorK::PG::IO; 31use WeBWorK::PG::IO(); # don't important any command directly
31use Tie::IxHash; 32use Tie::IxHash;
32 33
33################################## 34##################################
34# Utility macro 35# Utility macro
35################################## 36##################################
80 unlabeled_answer_eval_count => 0, 81 unlabeled_answer_eval_count => 0,
81 KEPT_EXTRA_ANSWERS => [], 82 KEPT_EXTRA_ANSWERS => [],
82 ANSWER_PREFIX => 'AnSwEr', 83 ANSWER_PREFIX => 'AnSwEr',
83 ARRAY_PREFIX => 'ArRaY', 84 ARRAY_PREFIX => 'ArRaY',
84 vec_num => 0, # for distinguishing matrices 85 vec_num => 0, # for distinguishing matrices
85 QUIZ_PREFIX => '', 86 QUIZ_PREFIX => $envir->{QUIZ_PREFIX},
86 SECTION_PREFIX => '', # might be used for sequential (compound) questions? 87 SECTION_PREFIX => '', # might be used for sequential (compound) questions?
87 88
88 PG_ACTIVE => 1, # turn to zero to stop processing 89 PG_ACTIVE => 1, # turn to zero to stop processing
89 submittedAnswers => 0, # have any answers been submitted? is this the first time this session? 90 submittedAnswers => 0, # have any answers been submitted? is this the first time this session?
90 PG_session_persistence_hash =>{}, # stores data from one invoction of the session to the next. 91 PG_session_persistence_hash =>{}, # stores data from one invoction of the session to the next.
117 118
118 $self->{tempDirectory} = $self->{envir}->{tempDirectory}; 119 $self->{tempDirectory} = $self->{envir}->{tempDirectory};
119 $self->{PG_problem_grader} = $self->{envir}->{PROBLEM_GRADER_TO_USE}; 120 $self->{PG_problem_grader} = $self->{envir}->{PROBLEM_GRADER_TO_USE};
120 $self->{PG_alias} = new PGalias($self->{envir}); 121 $self->{PG_alias} = new PGalias($self->{envir});
121 $self->{PG_loadMacros} = new PGloadfiles($self->{envir}); 122 $self->{PG_loadMacros} = new PGloadfiles($self->{envir});
122 $self->{PG_FLAGS} = { 123 $self->{flags} = {
123 showpartialCorrectAnswers => 1, 124 showpartialCorrectAnswers => 1,
124 showHint => 1, 125 showHint => 1,
125 hintExists => 0, 126 hintExists => 0,
126 showHintLimit => 0, 127 showHintLimit => 0,
127 solutionExists => 0, 128 solutionExists => 0,
284sub LABELED_ANS{ 285sub LABELED_ANS{
285 my $self = shift; 286 my $self = shift;
286 my @in = @_; 287 my @in = @_;
287 while (@in ) { 288 while (@in ) {
288 my $label = shift @in; 289 my $label = shift @in;
289 $label = join("", $self->{QUIZ_PREFIX}, $self->{SECTION_PREFIX}, $label); 290 #$label = join("", $self->{QUIZ_PREFIX}, $self->{SECTION_PREFIX}, $label);
290 my $ans_eval = shift @in; 291 my $ans_eval = shift @in;
291 $self->WARN("<BR><B>Error in LABELED_ANS:|$label|</B> 292 $self->WARN("<BR><B>Error in LABELED_ANS:|$label|</B>
292 -- inputs must be references to AnswerEvaluator objects or subroutines<BR>") 293 -- inputs must be references to AnswerEvaluator objects or subroutines<BR>")
293 unless ref($ans_eval) =~ /CODE/ or ref($ans_eval) =~ /AnswerEvaluator/ ; 294 unless ref($ans_eval) =~ /CODE/ or ref($ans_eval) =~ /AnswerEvaluator/ ;
294 if (defined($self->{PG_ANSWERS_HASH}->{$label}) ){ 295 if (defined($self->{PG_ANSWERS_HASH}->{$label}) ){
666 667
667 my $self = shift; 668 my $self = shift;
668 my $path = shift; 669 my $path = shift;
669 my $delim = "/"; 670 my $delim = "/";
670 my $tmpDirectory = $self->tempDirectory(); 671 my $tmpDirectory = $self->tempDirectory();
672#warn "\nTMP tmpDirectory $tmpDirectory";
671 unless ( -e $tmpDirectory) { # if by some unlucky chance the tmpDirectory hasn't been created, create it. 673 unless ( -e $tmpDirectory) { # if by some unlucky chance the tmpDirectory hasn't been created, create it.
672 my $parentDirectory = $tmpDirectory; 674 my $parentDirectory = $tmpDirectory;
673 $parentDirectory =~s|/$||; # remove a trailing / 675 $parentDirectory =~s|/$||; # remove a trailing /
674 $parentDirectory =~s|/\w*$||; # remove last node 676 $parentDirectory =~s|/\w*$||; # remove last node
675 my ($perms, $groupID) = (stat $parentDirectory)[2,5]; 677 my ($perms, $groupID) = (stat $parentDirectory)[2,5];
678 #FIXME where is the parentDirectory defined??
679#warn "Creating tmp directory at $tmpDirectory, perms $perms groupID $groupID";
676 createDirectory($tmpDirectory, $perms, $groupID) 680 $self->createDirectory($tmpDirectory, $perms, $groupID)
677 or warn "Failed to create directory at $path"; 681 or warn "Failed to create parent tmp directory at $path";
678 682
679 } 683 }
680 # use the permissions/group on the temp directory itself as a template 684 # use the permissions/group on the temp directory itself as a template
681 my ($perms, $groupID) = (stat $tmpDirectory)[2,5]; 685 my ($perms, $groupID) = (stat $tmpDirectory)[2,5];
682 #warn "&urePathToTmpFile: perms=$perms groupID=$groupID\n"; 686#warn "&urePathToTmpFile: directory=$tmpDirectory, perms=$perms, groupID=$groupID\n";
683 687
684 # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment 688 # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment
685 $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|; 689 $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|;
686 #$path = convertPath($path); 690 #$path = $self->convertPath($path);
687 691
688 # find the nodes on the given path 692 # find the nodes on the given path
689 my @nodes = split("$delim",$path); 693 my @nodes = split("$delim",$path);
690 694
691 # create new path 695 # create new path
692 $path = $tmpDirectory; #convertPath("$tmpDirectory"); 696 $path = $tmpDirectory; #convertPath("$tmpDirectory");
693 697
694 while (@nodes>1) { 698 while (@nodes>1) {
695 $path = $path . shift (@nodes) . "/"; #convertPath($path . shift (@nodes) . "/"); 699 $path = $path . shift (@nodes) . "/"; #convertPath($path . shift (@nodes) . "/");
700#warn "\PATH is now $path";
696 unless (-e $path) { 701 unless (-e $path) {
697 #system("mkdir $path"); 702 #system("mkdir $path");
698 #createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID) 703 #createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID)
704#warn "PATH $path perms $perms groupID $groupID";
699 createDirectory($path, $perms, $groupID) 705 $self->createDirectory($path, $perms, $groupID)
700 or warn "Failed to create directory at $path"; 706 or warn "Failed to create directory at $path with permissions $perms and groupID $groupID";
701 } 707 }
702 708
703 } 709 }
704 710
705 $path = $path . shift(@nodes); #convertPath($path . shift(@nodes)); 711 $path = $path . shift(@nodes); #convertPath($path . shift(@nodes));

Legend:
Removed from v.6252  
changed lines
  Added in v.6280

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9