[system] / trunk / pg / macros / PGanswermacros.pl Repository:
ViewVC logotype

Diff of /trunk/pg/macros/PGanswermacros.pl

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

Revision 6247 Revision 6248
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/PGanswermacros.pl,v 1.71 2009/11/02 16:55:51 apizer Exp $ 4# $CVSHeader: pg/macros/PGanswermacros.pl,v 1.72 2010/02/01 01:33:05 apizer 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.
1445 return $rh_ans; 1445 return $rh_ans;
1446} 1446}
1447 1447
1448 1448
1449 1449
1450=head2 Filter utilities
1451
1452These two subroutines can be used in filters to set default options. They
1453help make filters perform in uniform, predictable ways, and also make it
1454easy to recognize from the code which options a given filter expects.
1455
1456
1457=head4 assign_option_aliases
1458
1459Use this to assign aliases for the standard options. It must come before set_default_options
1460within the subroutine.
1461
1462 assign_option_aliases(\%options,
1463 'alias1' => 'option5'
1464 'alias2' => 'option7'
1465 );
1466
1467
1468If the subroutine is called with an option " alias1 => 23 " it will behave as if it had been
1469called with the option " option5 => 23 "
1470
1471=cut
1472
1473
1474# ^function assign_option_aliases
1475sub assign_option_aliases {
1476 my $rh_options = shift;
1477 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
1478 my @option_aliases = @_;
1479 while (@option_aliases) {
1480 my $alias = shift @option_aliases;
1481 my $option_key = shift @option_aliases;
1482
1483 if (defined($rh_options->{$alias} )) { # if the alias appears in the option list
1484 if (not defined($rh_options->{$option_key}) ) { # and the option itself is not defined,
1485 $rh_options->{$option_key} = $rh_options->{$alias}; # insert the value defined by the alias into the option value
1486 # the FIRST alias for a given option takes precedence
1487 # (after the option itself)
1488 } else {
1489 warn "option $option_key is already defined as", $rh_options->{$option_key}, "<br>\n",
1490 "The attempt to override this option with the alias $alias with value ", $rh_options->{$alias},
1491 " was ignored.";
1492 }
1493 }
1494 delete($rh_options->{$alias}); # remove the alias from the initial list
1495 }
1496
1497}
1498
1499=head4 set_default_options
1500
1501 set_default_options(\%options,
1502 '_filter_name' => 'filter',
1503 'option5' => .0001,
1504 'option7' => 'ascii',
1505 'allow_unknown_options => 0,
1506 }
1507
1508Note that the first entry is a reference to the options with which the filter was called.
1509
1510The option5 is set to .0001 unless the option is explicitly set when the subroutine is called.
1511
1512The B<'_filter_name'> option should always be set, although there is no error if it is missing.
1513It is used mainly for debugging answer evaluators and allows
1514you to keep track of which filter is currently processing the answer.
1515
1516If B<'allow_unknown_options'> is set to 0 then if the filter is called with options which do NOT appear in the
1517set_default_options list an error will be signaled and a warning message will be printed out. This provides
1518error checking against misspelling an option and is generally what is desired for most filters.
1519
1520Occasionally one wants to write a filter which accepts a long list of options, not all of which are known in advance,
1521but only uses a subset of the options
1522provided. In this case, setting 'allow_unkown_options' to 1 prevents the error from being signaled.
1523
1524=cut
1525
1526# ^function set_default_options
1527# ^uses pretty_print
1528sub set_default_options {
1529 my $rh_options = shift;
1530 warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
1531 my %default_options = @_;
1532 unless ( defined($default_options{allow_unknown_options}) and $default_options{allow_unknown_options} == 1 ) {
1533 foreach my $key1 (keys %$rh_options) {
1534 warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1});
1535 }
1536 }
1537 foreach my $key (keys %default_options) {
1538 if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) {
1539 $rh_options->{$key} = $default_options{$key}; #this allows tol => undef to allow the tol option, but doesn't define
1540 # this key unless tol is explicitly defined.
1541 }
1542 }
1543}
1544 1450
1545=head2 Problem Grader Subroutines 1451=head2 Problem Grader Subroutines
1546 1452
1547=cut 1453=cut
1548 1454
1873# ^uses pretty_print 1779# ^uses pretty_print
1874sub pretty_print { 1780sub pretty_print {
1875 my $r_input = shift; 1781 my $r_input = shift;
1876 my $out = ''; 1782 my $out = '';
1877 if ( not ref($r_input) ) { 1783 if ( not ref($r_input) ) {
1878 $out = $r_input; # not a reference 1784 $out = $r_input if defined $r_input; # not a reference
1879 $out =~ s/</&lt;/g; # protect for HTML output 1785 $out =~ s/</&lt;/g ; # protect for HTML output
1880 } elsif ("$r_input" =~/hash/i) { # this will pick up objects whose '$self' is hash and so works better than ref($r_iput). 1786 } elsif ("$r_input" =~/hash/i) { # this will pick up objects whose '$self' is hash and so works better than ref($r_iput).
1881 local($^W) = 0; 1787 local($^W) = 0;
1788
1882 $out .= "$r_input " ."<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">"; 1789 $out .= "$r_input " ."<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
1790
1791
1883 foreach my $key (lex_sort( keys %$r_input )) { 1792 foreach my $key (lex_sort( keys %$r_input )) {
1884 $out .= "<tr><TD> $key</TD><TD>=&gt;</td><td>&nbsp;".pretty_print($r_input->{$key}) . "</td></tr>"; 1793 $out .= "<tr><TD> $key</TD><TD>=&gt;</td><td>&nbsp;".pretty_print($r_input->{$key}) . "</td></tr>";
1885 } 1794 }
1795
1796
1797
1886 $out .="</table>"; 1798 $out .="</table>";
1887 } elsif (ref($r_input) eq 'ARRAY' ) { 1799 } elsif (ref($r_input) eq 'ARRAY' ) {
1888 my @array = @$r_input; 1800 my @array = @$r_input;
1889 $out .= "( " ; 1801 $out .= "( " ;
1890 while (@array) { 1802 while (@array) {
1893 $out .= " )"; 1805 $out .= " )";
1894 } elsif (ref($r_input) eq 'CODE') { 1806 } elsif (ref($r_input) eq 'CODE') {
1895 $out = "$r_input"; 1807 $out = "$r_input";
1896 } else { 1808 } else {
1897 $out = $r_input; 1809 $out = $r_input;
1898 $out =~ s/</&lt;/g; # protect for HTML output 1810 $out =~ s/</&lt;/g ; # protect for HTML output
1899 } 1811 }
1900 $out; 1812 $out;
1901} 1813}
1902 1814
19031; 18151;

Legend:
Removed from v.6247  
changed lines
  Added in v.6248

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9