[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 6249 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/macros/PG.pl,v 1.40 2009/06/25 23:28:44 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##################################
37
38=head2 Utility Macros
39
40 not_null(item) returns 1 or 0
41
42 empty arrays, empty hashes, strings containing only whitespace are all NULL and return 0
43 all undefined quantities are null and return 0
44
45
46=cut
36 47
37sub not_null { # empty arrays, empty hashes and strings containing only whitespace are all NULL 48sub not_null { # empty arrays, empty hashes and strings containing only whitespace are all NULL
38 my $item = shift; 49 my $item = shift;
39 return 0 unless defined($item); 50 return 0 unless defined($item);
40 if (ref($item)=~/ARRAY/) { 51 if (ref($item)=~/ARRAY/) {
70 unlabeled_answer_eval_count => 0, 81 unlabeled_answer_eval_count => 0,
71 KEPT_EXTRA_ANSWERS => [], 82 KEPT_EXTRA_ANSWERS => [],
72 ANSWER_PREFIX => 'AnSwEr', 83 ANSWER_PREFIX => 'AnSwEr',
73 ARRAY_PREFIX => 'ArRaY', 84 ARRAY_PREFIX => 'ArRaY',
74 vec_num => 0, # for distinguishing matrices 85 vec_num => 0, # for distinguishing matrices
75 QUIZ_PREFIX => '', 86 QUIZ_PREFIX => $envir->{QUIZ_PREFIX},
76 SECTION_PREFIX => '', # might be used for sequential (compound) questions? 87 SECTION_PREFIX => '', # might be used for sequential (compound) questions?
77 88
78 PG_ACTIVE => 1, # turn to zero to stop processing 89 PG_ACTIVE => 1, # turn to zero to stop processing
79 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?
80 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.
107 118
108 $self->{tempDirectory} = $self->{envir}->{tempDirectory}; 119 $self->{tempDirectory} = $self->{envir}->{tempDirectory};
109 $self->{PG_problem_grader} = $self->{envir}->{PROBLEM_GRADER_TO_USE}; 120 $self->{PG_problem_grader} = $self->{envir}->{PROBLEM_GRADER_TO_USE};
110 $self->{PG_alias} = new PGalias($self->{envir}); 121 $self->{PG_alias} = new PGalias($self->{envir});
111 $self->{PG_loadMacros} = new PGloadfiles($self->{envir}); 122 $self->{PG_loadMacros} = new PGloadfiles($self->{envir});
112 $self->{PG_FLAGS} = { 123 $self->{flags} = {
113 showpartialCorrectAnswers => 1, 124 showpartialCorrectAnswers => 1,
114 showHint => 1, 125 showHint => 1,
115 hintExists => 0, 126 hintExists => 0,
116 showHintLimit => 0, 127 showHintLimit => 0,
117 solutionExists => 0, 128 solutionExists => 0,
274sub LABELED_ANS{ 285sub LABELED_ANS{
275 my $self = shift; 286 my $self = shift;
276 my @in = @_; 287 my @in = @_;
277 while (@in ) { 288 while (@in ) {
278 my $label = shift @in; 289 my $label = shift @in;
279 $label = join("", $self->{QUIZ_PREFIX}, $self->{SECTION_PREFIX}, $label); 290 #$label = join("", $self->{QUIZ_PREFIX}, $self->{SECTION_PREFIX}, $label);
280 my $ans_eval = shift @in; 291 my $ans_eval = shift @in;
281 $self->WARN("<BR><B>Error in LABELED_ANS:|$label|</B> 292 $self->WARN("<BR><B>Error in LABELED_ANS:|$label|</B>
282 -- inputs must be references to AnswerEvaluator objects or subroutines<BR>") 293 -- inputs must be references to AnswerEvaluator objects or subroutines<BR>")
283 unless ref($ans_eval) =~ /CODE/ or ref($ans_eval) =~ /AnswerEvaluator/ ; 294 unless ref($ans_eval) =~ /CODE/ or ref($ans_eval) =~ /AnswerEvaluator/ ;
284 if (defined($self->{PG_ANSWERS_HASH}->{$label}) ){ 295 if (defined($self->{PG_ANSWERS_HASH}->{$label}) ){
656 667
657 my $self = shift; 668 my $self = shift;
658 my $path = shift; 669 my $path = shift;
659 my $delim = "/"; 670 my $delim = "/";
660 my $tmpDirectory = $self->tempDirectory(); 671 my $tmpDirectory = $self->tempDirectory();
672#warn "\nTMP tmpDirectory $tmpDirectory";
661 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.
662 my $parentDirectory = $tmpDirectory; 674 my $parentDirectory = $tmpDirectory;
663 $parentDirectory =~s|/$||; # remove a trailing / 675 $parentDirectory =~s|/$||; # remove a trailing /
664 $parentDirectory =~s|/\w*$||; # remove last node 676 $parentDirectory =~s|/\w*$||; # remove last node
665 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";
666 createDirectory($tmpDirectory, $perms, $groupID) 680 $self->createDirectory($tmpDirectory, $perms, $groupID)
667 or warn "Failed to create directory at $path"; 681 or warn "Failed to create parent tmp directory at $path";
668 682
669 } 683 }
670 # 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
671 my ($perms, $groupID) = (stat $tmpDirectory)[2,5]; 685 my ($perms, $groupID) = (stat $tmpDirectory)[2,5];
672 #warn "&urePathToTmpFile: perms=$perms groupID=$groupID\n"; 686#warn "&urePathToTmpFile: directory=$tmpDirectory, perms=$perms, groupID=$groupID\n";
673 687
674 # 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
675 $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|; 689 $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|;
676 #$path = convertPath($path); 690 #$path = $self->convertPath($path);
677 691
678 # find the nodes on the given path 692 # find the nodes on the given path
679 my @nodes = split("$delim",$path); 693 my @nodes = split("$delim",$path);
680 694
681 # create new path 695 # create new path
682 $path = $tmpDirectory; #convertPath("$tmpDirectory"); 696 $path = $tmpDirectory; #convertPath("$tmpDirectory");
683 697
684 while (@nodes>1) { 698 while (@nodes>1) {
685 $path = $path . shift (@nodes) . "/"; #convertPath($path . shift (@nodes) . "/"); 699 $path = $path . shift (@nodes) . "/"; #convertPath($path . shift (@nodes) . "/");
700#warn "\PATH is now $path";
686 unless (-e $path) { 701 unless (-e $path) {
687 #system("mkdir $path"); 702 #system("mkdir $path");
688 #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";
689 createDirectory($path, $perms, $groupID) 705 $self->createDirectory($path, $perms, $groupID)
690 or warn "Failed to create directory at $path"; 706 or warn "Failed to create directory at $path with permissions $perms and groupID $groupID";
691 } 707 }
692 708
693 } 709 }
694 710
695 $path = $path . shift(@nodes); #convertPath($path . shift(@nodes)); 711 $path = $path . shift(@nodes); #convertPath($path . shift(@nodes));

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9