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

    1 package WeBWorK::ContentGenerator;
    2 
    3 use CGI qw(-compile :html :form);
    4 use Apache::Constants qw(:common);
    5 
    6 # Send 'die' message to the browser window
    7 use CGI::Carp qw(fatalsToBrowser);
    8 
    9 
   10 # This is a superclass for Apache::WeBWorK's content generators.
   11 # You are /definitely/ encouraged to read this file, since there are
   12 # "abstract" functions here which show aproximately what form you would
   13 # want over-ridden sub-classes to follow.
   14 
   15 # new(Apache::Request, WeBWorK::CourseEnvironment)
   16 sub new($$$) {
   17   my $invocant = shift;
   18   my $class = ref($invocant) || $invocant;
   19   my $self = {};
   20   ($self->{r}, $self->{courseEnvironment}) = @_;
   21   bless $self, $class;
   22   return $self;
   23 }
   24 
   25 
   26 # This is a quick and dirty function to print out all (or almost all) of the
   27 # fields in a form in a specified format.  As you can see from the print
   28 # statement, it just prints out $begining$name$middle$value$end for every
   29 # field who's name doesn't match $qr_omit, a quoted regex.
   30 # In it's current incarnation, it should be called from subclasses only,
   31 # by saying $self->print_form_data.  Of course, you could construct a
   32 # hashref with ->{r} being an Apache::Request, I suppose.
   33 
   34 sub print_form_data {
   35   my ($self, $begin, $middle, $end, $qr_omit) = @_;
   36   my $return_string = "";
   37 
   38   $r=$self->{r};
   39   my @form_data = $r->param;
   40   foreach my $name (@form_data) {
   41     next if ($qr_omit and $name =~ /$qr_omit/);
   42     my @values = $r->param($name);
   43     foreach my $value (@values) {
   44       $return_string .= "$begin$name$middle$value$end";
   45     }
   46   }
   47 
   48   return $return_string;
   49 }
   50 
   51 sub hidden_authen_fields {
   52   my $self = shift;
   53   my $r = $self->{r};
   54   my $courseEnvironment = $self->{courseEnvironment};
   55   my $html = "";
   56 
   57   foreach $param ("user","effectiveUser","key") {
   58     my $value = $r->param($param);
   59     $html .= input({-type=>"hidden",-name=>"$param",-value=>"$value"});
   60   }
   61   return $html;
   62 }
   63 
   64 ### Functions that subclasses /should/ override under most circumstances
   65 
   66 sub title {
   67   return "Superclass";
   68 }
   69 
   70 sub body {
   71   print "Generated content";
   72   "";
   73 }
   74 
   75 ### Functions that subclasses /may/ want to override, if they've got something
   76 ### special to say
   77 
   78 sub pre_header_initialize {}
   79 
   80 sub header {
   81   my $self = shift;
   82   my $r=$self->{r};
   83   $r->content_type('text/html');
   84   $r->send_http_header();
   85 }
   86 
   87 sub initialize {}
   88 
   89 ### Content-generating functions that should probably not be overridden
   90 ### by most subclasses
   91 
   92 sub logo {
   93   my $self = shift;
   94   return $self->{courseEnvironment}->{urls}->{logo};
   95 }
   96 
   97 sub htdocs_base {
   98   my $self = shift;
   99   return $self->{courseEnvironment}->{urls}->{base};
  100 }
  101 
  102 sub test_args {
  103   my %args = %{$_[-1]};
  104 
  105   print "<pre>";
  106   print "$_ => $args{$_}\n" foreach (keys %args);
  107   print "</pre>";
  108   "";
  109 }
  110 
  111 # Used by &go to parse the argument fields of the template escapes
  112 sub cook_args($) {
  113   my ($raw_args) = @_;
  114   my $args = {};
  115   #my $quotable_string = qr/(?:".*?(?<![^\\](?:\\\\)*\\)"|\W*)/;
  116   #my $quotable_string = qr/(?:".*?(?<!\\)"|\W*)/;
  117   #my $test_string = '"hel \" lo" hello';
  118 
  119   #warn $test_string =~ m/($quotable_string)/ ? $1 : "false";
  120 
  121   while ($raw_args =~ m/\G\s*(\w*)="(.*?)"/g) {
  122   #while ($raw_args =~ m/\G\s*($quotable_string)=($quotable_string)/g) {
  123     $args->{$1} = $2;
  124   }
  125 
  126   return $args;
  127 }
  128 
  129 # Perform substitution in a template file and print it.  This should be called
  130 # for all content generators that are creating HTML output, and is called by
  131 # default by the &go method.
  132 sub template {
  133   my ($self, $templateFile) = (shift, shift);
  134   my $r = $self->{r};
  135   my $courseEnvironment = $self->{courseEnvironment};
  136 
  137   open(TEMPLATE, $templateFile) or die "Couldn't open template $templateFile";
  138   my @template = <TEMPLATE>;
  139   close TEMPLATE;
  140 
  141   foreach my $line (@template) {
  142     # This is incremental regex processing.
  143     # the /c is so that pos($line) doesn't die when the regex fails.
  144     while ($line =~ m/\G(.*?)<!--#(\w*)((?:\s+.*?)?)-->/gc) {
  145       my ($before, $function, $raw_args) = ($1, $2, $3);
  146       # $args here will be a hashref
  147       my $args = cook_args $raw_args if $raw_args =~ /\S/;
  148       print $before;
  149       print $self->$function(@_, $args) if $self->can($function);
  150     }
  151     print substr $line, pos($line);
  152   }
  153 }
  154 
  155 # Do whatever needs to be done in order to get a page to the client.  You
  156 # probably don't want to override this unless you're not making a web page
  157 # with the template.
  158 sub go {
  159   my $self = shift;
  160   my $r = $self->{r};
  161   my $courseEnvironment = $self->{courseEnvironment};
  162 
  163   $self->pre_header_initialize(@_);
  164   $self->header(@_); return OK if $r->header_only;
  165   $self->initialize(@_);
  166 
  167   $self->template($courseEnvironment->{templates}->{system}, @_);
  168 
  169   return OK;
  170 }
  171 
  172 1;