[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 6261 - (download) (as text) (annotate)
Sat May 15 18:41:23 2010 UTC (9 years, 6 months ago) by gage
File size: 23497 byte(s)
added fixes to PGalias.pm and PGcore.pm related to using $self-> in contexts
where the binding was not as expected (e.g.  in 'blah'. $self->{foobar} .'blah' )

Other minor fixes and improvements.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9