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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6280 - (download) (as text) (annotate)
Thu May 27 02:22:51 2010 UTC (9 years, 6 months ago) by gage
File size: 23526 byte(s)
changed parts of LABELED_ANS (and PGcore::new) so that it properly handles the
QUIZ_PREFIX needed by gateway quizzes.

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: pg/lib/PGcore.pm,v 1.6 2010/05/25 22:47:52 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 package PGcore;
   17 
   18 use strict;
   19 BEGIN {
   20   use Exporter 'import';
   21   our @EXPORT_OK = qw(not_null);
   22 }
   23 our $internal_debug_messages = [];
   24 
   25 
   26 use PGanswergroup;
   27 use PGresponsegroup;
   28 use PGrandom;
   29 use PGalias;
   30 use PGloadfiles;
   31 use WeBWorK::PG::IO(); # don't important any command directly
   32 use Tie::IxHash;
   33 
   34 ##################################
   35 # Utility macro
   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
   47 
   48 sub not_null {        # empty arrays, empty hashes and strings containing only whitespace are all NULL
   49     my $item = shift;
   50   return 0 unless defined($item);
   51   if (ref($item)=~/ARRAY/) {
   52     return scalar(@{$item});     # return the length
   53   } elsif (ref($item)=~/HASH/) {
   54       return scalar( keys %{$item});
   55   } else {   # string case return 1 if none empty
   56     return ($item =~ /\S/)? 1:0;
   57   }
   58 }
   59 
   60 ##################################
   61 # PGcore object
   62 ##################################
   63 
   64 sub new {
   65   my $class = shift;
   66   my $envir = shift;  #pointer to environment hash
   67   warn "PGcore must be called with an environment" unless ref($envir) eq 'HASH';
   68   #warn "creating a new PGcore object";
   69   my %options = @_;
   70   my $self = {
   71     OUTPUT_ARRAY              => [],          # holds output body text
   72     HEADER_ARRAY              => [],         # holds output for the header text
   73 #   PG_ANSWERS                => [],  # holds answers with labels
   74 #   PG_UNLABELED_ANSWERS      => [],  # holds
   75     PG_ANSWERS_HASH           => {},  # holds label=>answer pairs
   76     PERSISTENCE_HASH           => {}, # holds other data, besides answers, which persists during a session and beyond
   77 #   PG_persistence_hash       => {},  # stores information (other than answers) from one session to another
   78     answer_eval_count         => 0,
   79     answer_blank_count        => 0,
   80     unlabeled_answer_blank_count =>0,
   81     unlabeled_answer_eval_count  => 0,
   82     KEPT_EXTRA_ANSWERS        => [],
   83     ANSWER_PREFIX             => 'AnSwEr',
   84     ARRAY_PREFIX              => 'ArRaY',
   85     vec_num                   => 0,     # for distinguishing matrices
   86     QUIZ_PREFIX               => $envir->{QUIZ_PREFIX},
   87     SECTION_PREFIX            => '',  # might be used for sequential (compound) questions?
   88 
   89     PG_ACTIVE                 => 1,   # turn to zero to stop processing
   90     submittedAnswers          => 0,   # have any answers been submitted? is this the first time this session?
   91     PG_session_persistence_hash =>{}, # stores data from one invoction of the session to the next.
   92     PG_original_problem_seed  => 0,
   93     PG_random_generator     => undef,
   94     PG_alias                  => undef,
   95     PG_problem_grader         => undef,
   96     displayMode               => undef,
   97     envir                     => $envir,
   98     gifs_created              => {},
   99     external_refs             => {},      # record of external references
  100     %options,                                   # allows overrides and initialization
  101   };
  102   bless $self, $class;
  103   tie %{$self->{PG_ANSWERS_HASH}}, "Tie::IxHash";  # creates a Hash with order
  104   $self->initialize;
  105   return $self;
  106 }
  107 
  108 sub initialize {
  109   my $self = shift;
  110   warn "environment is not defined in PGcore" unless ref($self->{envir}) eq 'HASH';
  111 
  112 
  113 
  114 
  115   $self->{displayMode}                = $self->{envir}->{displayMode};
  116   $self->{PG_original_problem_seed}   = $self->{envir}->{problemSeed};
  117   $self->{PG_random_generator}        = new PGrandom( $self->{PG_original_problem_seed});
  118 
  119     $self->{tempDirectory}              = $self->{envir}->{tempDirectory};
  120   $self->{PG_problem_grader}    = $self->{envir}->{PROBLEM_GRADER_TO_USE};
  121     $self->{PG_alias}             = new PGalias($self->{envir});
  122     $self->{PG_loadMacros}        = new PGloadfiles($self->{envir});
  123   $self->{flags} = {
  124     showpartialCorrectAnswers => 1,
  125     showHint                  => 1,
  126     hintExists          => 0,
  127     showHintLimit             => 0,
  128     solutionExists            => 0,
  129     WARNING_messages          => [],
  130     DEBUG_messages            => [],
  131     recordSubmittedAnswers    => 1,
  132     refreshCAchedImages       => 0,
  133 #   ANSWER_ENTRY_ORDER        => [],  # may not be needed if we ue Tie:IxHash
  134     comment                   => '',  # implement as array?
  135 
  136 
  137 
  138   };
  139 
  140 }
  141 
  142 
  143 ####################################################################
  144 
  145 =head1 DESCRIPTION
  146 
  147 This file provides the fundamental macros that define the PG language. It
  148 maintains a problem's text, header text, and answers:
  149 
  150 =over
  151 
  152 =item *
  153 
  154 Problem text: The text to appear in the body of the problem. See TEXT()
  155 below.
  156 
  157 =item *
  158 
  159 Header text: When a problem is processed in an HTML-based display mode,
  160 this variable can contain text that the caller should place in the HEAD of the
  161 resulting HTML page. See HEADER_TEXT() below.
  162 
  163 =item *
  164 
  165 Implicitly-labeled answers: Answers that have not been explicitly
  166 assigned names, and are associated with their answer blanks by the order in
  167 which they appear in the problem. These types of answers are designated using
  168 the ANS() macro.
  169 
  170 =item *
  171 
  172 Explicitly-labeled answers: Answers that have been explicitly assigned
  173 names with the LABELED_ANS() macro, or a macro that uses it. An explicitly-
  174 labeled answer is associated with its answer blank by name.
  175 
  176 =item *
  177 
  178 "Extra" answers: Names of answer blanks that do not have a 1-to-1
  179 correspondance to an answer evaluator. For example, in matrix problems, there
  180 will be several input fields that correspond to the same answer evaluator.
  181 
  182 =back
  183 
  184 =head1 USAGE
  185 
  186 This file is automatically loaded into the namespace of every PG problem. The
  187 macros within can then be called to define the structure of the problem.
  188 
  189 DOCUMENT() should be the first executable statement in any problem. It
  190 initializes vriables and defines the problem environment.
  191 
  192 ENDDOCUMENT() must be the last executable statement in any problem. It packs
  193 up the results of problem processing for delivery back to WeBWorK.
  194 
  195 The HEADER_TEXT(), TEXT(), and ANS() macros add to the header text string,
  196 body text string, and answer evaluator queue, respectively.
  197 
  198 =cut
  199 
  200 
  201 =item HEADER_TEXT()
  202 
  203  HEADER_TEXT("string1", "string2", "string3");
  204 
  205 HEADER_TEXT() concatenates its arguments and appends them to the stored header
  206 text string. It can be used more than once in a file.
  207 
  208 The macro is used for material which is destined to be placed in the HEAD of
  209 the page when in HTML mode, such as JavaScript code.
  210 
  211 Spaces are placed between the arguments during concatenation, but no spaces are
  212 introduced between the existing content of the header text string and the new
  213 content being appended.
  214 
  215 =cut
  216 
  217 # ^function HEADER_TEXT
  218 # ^uses $STRINGforHEADER_TEXT
  219 sub HEADER_TEXT {
  220   my $self = shift;
  221   push @{$self->{HEADER_ARRAY}}, map { (defined($_) )?$_:'' } @_;
  222   $self->{HEADER_ARRAY}  ;
  223 }
  224 
  225 =item TEXT()
  226 
  227  TEXT("string1", "string2", "string3");
  228 
  229 TEXT() concatenates its arguments and appends them to the stored problem text
  230 string. It is used to define the text which will appear in the body of the
  231 problem. It can be used more than once in a file.
  232 
  233 This macro has no effect if rendering has been stopped with the STOP_RENDERING()
  234 macro.
  235 
  236 This macro defines text which will appear in the problem. All text must be
  237 passed to this macro, passed to another macro that calls this macro, or included
  238 in a BEGIN_TEXT/END_TEXT block, which uses this macro internally. No other
  239 statements in a PG file will directly appear in the output. Think of this as the
  240 "print" function for the PG language.
  241 
  242 Spaces are placed between the arguments during concatenation, but no spaces are
  243 introduced between the existing content of the header text string and the new
  244 content being appended.
  245 
  246 =cut
  247 
  248 # ^function TEXT
  249 # ^uses $PG_STOP_FLAG
  250 # ^uses $STRINGforOUTPUT
  251 
  252 sub TEXT {
  253   my $self = shift;    #FIXME  filter for undefined entries replace by "";
  254   push @{$self->{OUTPUT_ARRAY}}, map { (defined($_) )?$_:'' } @_ ;
  255   $self->{OUTPUT_ARRAY};
  256 }
  257 
  258 
  259 =item LABELED_ANS()
  260 
  261  TEXT(labeled_ans_rule("name1"), labeled_ans_rule("name2"));
  262  LABELED_ANS(name1 => answer_evaluator1, name2 => answer_evaluator2);
  263 
  264 Adds the answer evaluators listed to the list of labeled answer evaluators.
  265 They will be paired with labeled answer rules (a.k.a. answer blanks) in the
  266 order entered. This allows pairing of answer evaluators and answer rules that
  267 may not have been entered in the same order.
  268 
  269 =cut
  270 
  271 # ^function NAMED_ANS
  272 # ^uses &LABELED_ANS
  273 sub NAMED_ANS {
  274   &LABELED_ANS;
  275 }
  276 
  277 =item NAMED_ANS()
  278 
  279 Old name for LABELED_ANS(). DEPRECATED.
  280 
  281 =cut
  282 
  283 # ^function NAMED_ANS
  284 # ^uses $PG_STOP_FLAG
  285 sub LABELED_ANS{
  286   my $self = shift;
  287   my @in = @_;
  288   while (@in ) {
  289     my $label    = shift @in;
  290     #$label       = join("", $self->{QUIZ_PREFIX}, $self->{SECTION_PREFIX}, $label);
  291     my $ans_eval = shift @in;
  292     $self->WARN("<BR><B>Error in LABELED_ANS:|$label|</B>
  293           -- inputs must be references to AnswerEvaluator objects or subroutines<BR>")
  294       unless ref($ans_eval) =~ /CODE/ or ref($ans_eval) =~ /AnswerEvaluator/  ;
  295   if (defined($self->{PG_ANSWERS_HASH}->{$label})  ){
  296     $self->{PG_ANSWERS_HASH}->{$label}->insert(ans_label => $label, ans_eval => $ans_eval, active=>$self->{PG_ACTIVE});
  297   } else {
  298       $self->{PG_ANSWERS_HASH}->{$label} = PGanswergroup->new($label, ans_eval => $ans_eval, active=>$self->{PG_ACTIVE});
  299     }
  300     $self->{answer_eval_count}++;
  301   }
  302   $self->{PG_ANSWERS_HASH};
  303 }
  304 
  305 
  306 =item ANS()
  307 
  308  TEXT(ans_rule(), ans_rule(), ans_rule());
  309  ANS($answer_evaluator1, $answer_evaluator2, $answer_evaluator3);
  310 
  311 Adds the answer evaluators listed to the list of unlabeled answer evaluators.
  312 They will be paired with unlabeled answer rules (a.k.a. answer blanks) in the
  313 order entered. This is the standard method for entering answers.
  314 
  315 In the above example, answer_evaluator1 will be associated with the first
  316 answer rule, answer_evaluator2 with the second, and answer_evaluator3 with the
  317 third. In practice, the arguments to ANS() will usually be calls to an answer
  318 evaluator generator such as the cmp() method of MathObjects or the num_cmp()
  319 macro in L<PGanswermacros.pl>.
  320 
  321 =cut
  322 
  323 # ^function ANS
  324 # ^uses $PG_STOP_FLAG
  325 # ^uses @PG_ANSWERS
  326 
  327 sub ANS{
  328   my $self = shift;
  329   my @in = @_;
  330   while (@in ) {
  331          # create new label
  332          $self->{unlabeled_answer_eval_count}++;
  333          my $label = $self->new_label($self->{unlabeled_answer_eval_count});
  334          my $evaluator = shift @in;
  335      $self->LABELED_ANS($label, $evaluator);
  336   }
  337   $self->{PG_ANSWERS_HASH};
  338 }
  339 
  340 
  341 
  342 
  343 =item STOP_RENDERING()
  344 
  345  STOP_RENDERING() unless all_answers_are_correct();
  346 
  347 Temporarily suspends accumulation of problem text and storing of answer blanks
  348 and answer evaluators until RESUME_RENDERING() is called.
  349 
  350 =cut
  351 
  352 # ^function STOP_RENDERING
  353 # ^uses $PG_STOP_FLAG
  354 sub STOP_RENDERING {
  355   my $self = shift;
  356   $self->{PG_ACTIVE}=0;
  357   "";
  358 }
  359 
  360 =item RESUME_RENDERING()
  361 
  362  RESUME_RENDERING();
  363 
  364 Resumes accumulating problem text and storing answer blanks and answer
  365 evaluators. Reverses the effect of STOP_RENDERING().
  366 
  367 =cut
  368 
  369 # ^function RESUME_RENDERING
  370 # ^uses $PG_STOP_FLAG
  371 sub RESUME_RENDERING {
  372   my $self = shift;
  373   $self->{PG_ACTIVE}=1;
  374   "";
  375 }
  376 ########
  377 # Internal methods
  378 #########
  379 sub new_label {     #creates a new label for unlabeled submissions ASNWER_PREFIX.$number
  380   my $self         = shift;
  381   my $number       = shift;
  382   $self->{QUIZ_PREFIX}.$self->{ANSWER_PREFIX}.sprintf("%04u", $number);
  383 }
  384 sub new_array_label {     #creates a new label for unlabeled submissions ASNWER_PREFIX.$number
  385   my $self         = shift;
  386   my $number       = shift;
  387   $self->{QUIZ_PREFIX}.$self->{ARRAY_PREFIX}.sprintf("%04u", $number);
  388 }
  389 sub new_array_element_label {     #creates a new label for unlabeled submissions ARRAY_PREFIX.$number
  390   my $self              = shift;
  391   my $ans_label         = shift;  # name of the PGanswer group holding this array
  392   my $row_num           = shift;
  393   my $col_num           = shift;
  394   my %options           = @_;
  395   my $vec_num           = (defined $options{vec_num})?$options{vec_num}: 0 ;
  396   $self->{QUIZ_PREFIX}.$ans_label.'__'.$vec_num.':'.$row_num.':'.$col_num.'__';
  397 }
  398 sub new_answer_name  {     # bit of a legacy item
  399   &new_label;
  400 }
  401 
  402 
  403 sub record_ans_name {      # the labels in the PGanswer group and response group should match in this case
  404   my $self = shift;
  405   my $label = shift;
  406   my $value = shift;
  407   $self->internal_debug_message("record_ans_name $label $value");
  408   my $response_group = new PGresponsegroup($label,$label,$value);
  409   if (defined($self->{PG_ANSWERS_HASH}->{$label}) ) {
  410     $self->{PG_ANSWERS_HASH}->{$label}->replace(ans_label => $label,
  411                                                response  => $response_group,
  412                                                active    => $self->{PG_ACTIVE});
  413   } else {
  414       $self->{PG_ANSWERS_HASH}->{$label} = PGanswergroup->new($label,
  415                                                  response  => $response_group,
  416                                                  active    => $self->{PG_ACTIVE});
  417     }
  418     $self->{answer_blank_count}++;
  419   $label;
  420 }
  421 
  422 sub record_array_name {  # currently the same as record ans group
  423   my $self = shift;
  424   my $label = shift;
  425   my $value = shift;
  426   my $response_group = new PGresponsegroup($label,$label,$value);
  427   if (defined($self->{PG_ANSWERS_HASH}->{$label}) ) {
  428     $self->{PG_ANSWERS_HASH}->{$label}->replace(ans_label => $label,
  429                                                response   => $response_group,
  430                                                active     => $self->{PG_ACTIVE});
  431   } else {
  432       $self->{PG_ANSWERS_HASH}->{$label} = PGanswergroup->new($label,
  433                                                  response   => $response_group,
  434                                                  active     => $self->{PG_ACTIVE});
  435     }
  436     $self->{answer_blank_count}++;
  437     #$self->{PG_ANSWERS_HASH}->{$label}->{response}->clear;  #why is this ?
  438   $label;
  439 
  440 }
  441 sub extend_ans_group {         # modifies the group type
  442   my $self = shift;
  443   my $label = shift;
  444   my @response_list = @_;
  445   my $answer_group  = $self->{PG_ANSWERS_HASH}->{$label};
  446   if (ref($answer_group) =~/PGanswergroup/) {
  447       $answer_group->append_responses(@response_list);
  448     } else {
  449       $self->WARN("The answer |$label| has not yet been defined, you cannot extend it.",caller() );
  450 
  451     }
  452     $label;
  453 }
  454 sub record_unlabeled_ans_name {
  455   my $self = shift;
  456     $self->{unlabeled_answer_blank_count}++;
  457     my $label = $self->new_label($self->{unlabeled_answer_blank_count});
  458     $self->record_ans_name($label);
  459     $label;
  460 }
  461 sub record_unlabeled_array_name {
  462   my $self = shift;
  463     $self->{unlabeled_answer_blank_count}++;
  464     my $ans_label = $self->new_array_label($self->{unlabeled_answer_blank_count});
  465     $self->record_array_name($ans_label);
  466 }
  467 sub store_persistent_data {  # will store strings only (so far)
  468   my $self = shift;
  469   my $label = shift;
  470   my @content = @_;
  471   $self->internal_debug_message("storing $label in PERSISTENCE_HASH");
  472   if (defined($self->{PERSISTENCE_HASH}->{$label}) ) {
  473     warn "can' overwrite $label in persistent data";
  474   } else {
  475       $self->{PERSISTENCE_HASH}->{$label} = join("",@content);  #need base64 encoding?
  476     }
  477   $label;
  478 }
  479 sub check_answer_hash {
  480   my $self = shift;
  481   foreach my $key (keys %{ $self->{PG_ANSWERS_HASH} }) {
  482       my $ans_eval = $self->{PG_ANSWERS_HASH}->{$key}->{ans_eval};
  483     unless (ref($ans_eval) =~ /CODE/ or ref($ans_eval) =~ /AnswerEvaluator/ ) {
  484       warn "The answer group labeled $key is missing an answer evaluator";
  485     }
  486     unless (ref( $self->{PG_ANSWERS_HASH}->{$key}->{response} ) =~ /PGresponsegroup/ ) {
  487       warn "The answer group labeled $key is missing answer blanks ";
  488     }
  489   }
  490 }
  491 
  492 sub PG_restricted_eval {
  493   my $self = shift;
  494   WeBWorK::PG::Translator::PG_restricted_eval(@_);
  495 }
  496 
  497 # sub AUTOLOAD {
  498 #   my $self = shift;
  499 #
  500 #   my $type = ref($self) or die "$self is not an object";
  501 #
  502 #   # $AUTOLOAD is sent in by Perl and is the full name of the object (i.e. main::blah::blah_more)
  503 #   my $name = $PGcore::AUTOLOAD;
  504 #   $name =~ s/.*://; #strips fully-qualified portion
  505 #
  506 #   unless ( exists $self->{'_permitted'}->{$name} ) { die "Can't find '$name' field in object of class '$type'";}
  507 #
  508 #   if (@_) {
  509 #     return $self->{$name} = shift; #set the variable to the first parameter
  510 #   } else {
  511 #     return $self->($name); #if no parameters just return the value
  512 #   }
  513 # }
  514 
  515 sub append_debug_message {
  516     my $self = shift;
  517   my @str = @_;
  518   push @{$self->{DEBUG_messages}}, @str;
  519 }
  520 sub get_debug_messages {
  521   my $self = shift;
  522   $self->{DEBUG_messages};
  523 }
  524 sub DESTROY {
  525   # doing nothing about destruction, hope that isn't dangerous
  526 }
  527 
  528 sub WARN {
  529   warn(@_);
  530 }
  531 
  532 
  533 # This creates on the fly graphs
  534 
  535 =head2 insertGraph
  536 
  537   # returns a path to the file containing the graph image.
  538   $filePath = insertGraph($graphObject);
  539 
  540 insertGraph writes a GIF or PNG image file to the gif subdirectory of the
  541 current course's HTML temp directory. The file name is obtained from the graph
  542 object. Warnings are issued if errors occur while writing to the file.
  543 
  544 Returns a string containing the full path to the temporary file containing the
  545 image. This is most often used in the construct
  546 
  547   TEXT(alias(insertGraph($graph)));
  548 
  549 where alias converts the directory address to a URL when serving HTML pages and
  550 insures that an EPS file is generated when creating TeX code for downloading.
  551 
  552 =cut
  553 
  554 # ^function insertGraph
  555 # ^uses $WWPlot::use_png
  556 # ^uses convertPath
  557 # ^uses surePathToTmpFile
  558 # ^uses PG_restricted_eval
  559 # ^uses $refreshCachedImages
  560 # ^uses $templateDirectory
  561 # ^uses %envir
  562 sub insertGraph {
  563   # Convert the image to GIF and print it on standard output
  564   my $self     = shift;
  565   my $graph    = shift;
  566   my $extension = ($WWPlot::use_png) ? '.png' : '.gif';
  567   my $fileName = $graph->imageName  . $extension;
  568   my $filePath = $self->convertPath("gif/$fileName");
  569   my $templateDirectory = $self->{envir}->{templateDirectory};
  570   $filePath = $self->surePathToTmpFile( $filePath );
  571   my $refreshCachedImages = $self->PG_restricted_eval(q!$refreshCachedImages!);
  572   # Check to see if we already have this graph, or if we have to make it
  573   if( not -e $filePath # does it exist?
  574     or ((stat "$templateDirectory"."$main::envir{fileName}")[9] > (stat $filePath)[9]) # source has changed
  575     or $graph->imageName =~ /Undefined_Set/ # problems from SetMaker and its ilk should always be redone
  576     or $refreshCachedImages
  577   ) {
  578     #createFile($filePath, $main::tmp_file_permission, $main::numericalGroupID);
  579     local(*OUTPUT);  # create local file handle so it won't overwrite other open files.
  580     open(OUTPUT, ">$filePath")||warn ("$0","Can't open $filePath<BR>","");
  581     chmod( 0777, $filePath);
  582     print OUTPUT $graph->draw|| warn("$0","Can't print graph to $filePath<BR>","");
  583     close(OUTPUT)||warn("$0","Can't close $filePath<BR>","");
  584   }
  585   $filePath;
  586 }
  587 
  588 =head1 Macros from IO.pm
  589 
  590     includePGtext
  591     read_whole_problem_file
  592     read_whole_file
  593     convertPath
  594     getDirDelim
  595     fileFromPath
  596     directoryFromPath
  597     createFile
  598     createDirectory
  599 
  600 =cut
  601 
  602 sub includePGtext {
  603   my $self = shift;
  604   WeBWorK::PG::IO::includePGtext(@_);
  605  };
  606 sub read_whole_problem_file {
  607   my $self = shift;
  608   WeBWorK::PG::IO::read_whole_problem_file(@_);
  609  };
  610 sub read_whole_file {
  611   my $self = shift;
  612   WeBWorK::PG::IO::read_whole_file(@_);
  613  };
  614 sub convertPath {
  615   my $self = shift;
  616   WeBWorK::PG::IO::convertPath(@_);
  617  };
  618 sub getDirDelim {
  619   my $self = shift;
  620   WeBWorK::PG::IO::getDirDelim(@_);
  621  };
  622 sub fileFromPath {
  623   my $self = shift;
  624   WeBWorK::PG::IO::fileFromPath(@_);
  625  };
  626 sub directoryFromPath {
  627   my $self = shift;
  628   WeBWorK::PG::IO::directoryFromPath(@_);
  629  };
  630 sub createFile {
  631   my $self = shift;
  632   WeBWorK::PG::IO::createFile(@_);
  633  };
  634 sub createDirectory {
  635   my $self = shift;
  636   WeBWorK::PG::IO::createDirectory(@_);
  637  };
  638 
  639 sub tempDirectory {
  640   my $self = shift;
  641   return $self->{tempDirectory};
  642 }
  643 
  644 
  645 =head2 surePathToTmpFile
  646 
  647   $path = surePathToTmpFile($path);
  648 
  649 Creates all of the intermediate directories between the tempDirectory
  650 
  651 If $path begins with the tempDirectory path, then the
  652 path is treated as absolute. Otherwise, the path is treated as relative the the
  653 course temp directory.
  654 
  655 =cut
  656 
  657 # A very useful macro for making sure that all of the directories to a file have been constructed.
  658 
  659 # ^function surePathToTmpFile
  660 # ^uses getCourseTempDirectory
  661 # ^uses createDirectory
  662 
  663 
  664 sub surePathToTmpFile {
  665   # constructs intermediate directories if needed beginning at ${Global::htmlDirectory}tmp/
  666   # the input path must be either the full path, or the path relative to this tmp sub directory
  667 
  668   my $self = shift;
  669   my $path = shift;
  670   my $delim = "/";
  671   my $tmpDirectory = $self->tempDirectory();
  672 #warn "\nTMP tmpDirectory $tmpDirectory";
  673   unless ( -e $tmpDirectory) {   # if by some unlucky chance the tmpDirectory hasn't been created, create it.
  674       my $parentDirectory =  $tmpDirectory;
  675       $parentDirectory =~s|/$||;  # remove a trailing /
  676       $parentDirectory =~s|/\w*$||; # remove last node
  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";
  680     $self->createDirectory($tmpDirectory, $perms, $groupID)
  681         or warn "Failed to create parent tmp directory at $path";
  682 
  683   }
  684   # use the permissions/group on the temp directory itself as a template
  685   my ($perms, $groupID) = (stat $tmpDirectory)[2,5];
  686 #warn "&urePathToTmpFile: directory=$tmpDirectory, perms=$perms, groupID=$groupID\n";
  687 
  688   # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment
  689   $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|;
  690   #$path = $self->convertPath($path);
  691 
  692   # find the nodes on the given path
  693         my @nodes = split("$delim",$path);
  694 
  695   # create new path
  696   $path = $tmpDirectory; #convertPath("$tmpDirectory");
  697 
  698   while (@nodes>1) {
  699     $path = $path . shift (@nodes) . "/"; #convertPath($path . shift (@nodes) . "/");
  700 #warn "\PATH is now $path";
  701     unless (-e $path) {
  702       #system("mkdir $path");
  703       #createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID)
  704 #warn "PATH $path perms $perms groupID $groupID";
  705       $self->createDirectory($path, $perms, $groupID)
  706         or warn "Failed to create directory at $path with permissions $perms and groupID $groupID";
  707     }
  708 
  709   }
  710 
  711   $path = $path . shift(@nodes); #convertPath($path . shift(@nodes));
  712   #system(qq!echo "" > $path! );
  713   return $path;
  714 }
  715 
  716 sub internal_debug_message {
  717     my $self = shift;
  718   my @str = @_;
  719   push @{$internal_debug_messages}, @str;
  720 }
  721 sub get_internal_debug_messages {
  722   my $self = shift;
  723   $internal_debug_messages;
  724 }
  725 sub clear_internal_debug_messages {
  726   my $self = shift;
  727   $internal_debug_messages=[];
  728 }
  729 
  730 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9