![]() ![]() | ![]() |
Corrections to remove html from statements.
1: # The LearningOnline Network with CAPA 2: # .helper XML handler to implement the LON-CAPA helper 3: # 4: # $Id: lonhelper.pm,v 1.78 2004/04/27 18:07:18 sakharuk Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: # (Page Handler 29: # 30: # (.helper handler 31: # 32: 33: =pod 34: 35: =head1 NAME 36: 37: lonhelper - implements helper framework 38: 39: =head1 SYNOPSIS 40: 41: lonhelper implements the helper framework for LON-CAPA, and provides 42: many generally useful components for that framework. 43: 44: Helpers are little programs which present the user with a sequence of 45: simple choices, instead of one monolithic multi-dimensional 46: choice. They are also referred to as "wizards", "druids", and 47: other potentially trademarked or semantically-loaded words. 48: 49: =head1 OVERVIEWX<lonhelper> 50: 51: Helpers are well-established UI widgets that users 52: feel comfortable with. It can take a complicated multidimensional problem the 53: user has and turn it into a series of bite-sized one-dimensional questions. 54: 55: For developers, helpers provide an easy way to bundle little bits of functionality 56: for the user, without having to write the tedious state-maintenence code. 57: 58: Helpers are defined as XML documents, placed in the /home/httpd/html/adm/helpers 59: directory and having the .helper file extension. For examples, see that directory. 60: 61: All classes are in the Apache::lonhelper namespace. 62: 63: =head1 lonhelper XML file formatX<lonhelper, XML file format> 64: 65: A helper consists of a top-level <helper> tag which contains a series of states. 66: Each state contains one or more state elements, which are what the user sees, like 67: messages, resource selections, or date queries. 68: 69: The helper tag is required to have one attribute, "title", which is the name 70: of the helper itself, such as "Parameter helper". The helper tag may optionally 71: have a "requiredpriv" attribute, specifying the priviledge a user must have 72: to use the helper, or get denied access. See loncom/auth/rolesplain.tab for 73: useful privs. Default is full access, which is often wrong! 74: 75: =head2 State tags 76: 77: State tags are required to have an attribute "name", which is the symbolic 78: name of the state and will not be directly seen by the user. The helper is 79: required to have one state named "START", which is the state the helper 80: will start with. By convention, this state should clearly describe what 81: the helper will do for the user, and may also include the first information 82: entry the user needs to do for the helper. 83: 84: State tags are also required to have an attribute "title", which is the 85: human name of the state, and will be displayed as the header on top of 86: the screen for the user. 87: 88: =head2 Example Helper Skeleton 89: 90: An example of the tags so far: 91: 92: <helper title="Example Helper"> 93: <state name="START" title="Demonstrating the Example Helper"> 94: <!-- notice this is the START state the wizard requires --> 95: </state> 96: <state name="GET_NAME" title="Enter Student Name"> 97: </state> 98: </helper> 99: 100: Of course this does nothing. In order for the wizard to do something, it is 101: necessary to put actual elements into the wizard. Documentation for each 102: of these elements follows. 103: 104: =head1 Creating a Helper With Code, Not XML 105: 106: In some situations, such as the printing wizard (see lonprintout.pm), 107: writing the helper in XML would be too complicated, because of scope 108: issues or the fact that the code actually outweighs the XML. It is 109: possible to create a helper via code, though it is a little odd. 110: 111: Creating a helper via code is more like issuing commands to create 112: a helper then normal code writing. For instance, elements will automatically 113: be added to the last state created, so it's important to create the 114: states in the correct order. 115: 116: First, create a new helper: 117: 118: use Apache::lonhelper; 119: 120: my $helper = Apache::lonhelper::new->("Helper Title"); 121: 122: Next you'll need to manually add states to the helper: 123: 124: Apache::lonhelper::state->new("STATE_NAME", "State's Human Title"); 125: 126: You don't need to save a reference to it because all elements up until 127: the next state creation will automatically be added to this state. 128: 129: Elements are created by populating the $paramHash in 130: Apache::lonhelper::paramhash. To prevent namespace issues, retrieve 131: a reference to that has with getParamHash: 132: 133: my $paramHash = Apache::lonhelper::getParamHash(); 134: 135: You will need to do this for each state you create. 136: 137: Populate the $paramHash with the parameters for the element you wish 138: to add next; the easiest way to find out what those entries are is 139: to read the code. Some common ones are 'variable' to record the variable 140: to store the results in, and NEXTSTATE to record a next state transition. 141: 142: Then create your element: 143: 144: $paramHash->{MESSAGETEXT} = "This is a message."; 145: Apache::lonhelper::message->new(); 146: 147: The creation will take the $paramHash and bless it into a 148: Apache::lonhelper::message object. To create the next element, you need 149: to get a reference to the new, empty $paramHash: 150: 151: $paramHash = Apache::lonhelper::getParamHash(); 152: 153: and you can repeat creating elements that way. You can add states 154: and elements as needed. 155: 156: See lonprintout.pm, subroutine printHelper for an example of this, where 157: we dynamically add some states to prevent security problems, for instance. 158: 159: Normally the machinery in the XML format is sufficient; dynamically 160: adding states can easily be done by wrapping the state in a <condition> 161: tag. This should only be used when the code dominates the XML content, 162: the code is so complicated that it is difficult to get access to 163: all of the information you need because of scoping issues, or would-be <exec> or 164: <eval> blocks using the {DATA} mechanism results in hard-to-read 165: and -maintain code. (See course.initialization.helper for a borderline 166: case.) 167: 168: It is possible to do some of the work with an XML fragment parsed by 169: lonxml; again, see lonprintout.pm for an example. In that case it is 170: imperative that you call B<Apache::lonhelper::registerHelperTags()> 171: before parsing XML fragments and B<Apache::lonhelper::unregisterHelperTags()> 172: when you are done. See lonprintout.pm for examples of this usage in the 173: printHelper subroutine. 174: 175: =head2 Localization 176: 177: The helper framework tries to handle as much localization as 178: possible. The text is always run through 179: Apache::lonlocal::normalize_string, so be sure to run the keys through 180: that function for maximum usefulness and robustness. 181: 182: =cut 183: 184: package Apache::lonhelper; 185: use Apache::Constants qw(:common); 186: use Apache::File; 187: use Apache::lonxml; 188: use Apache::lonlocal; 189: 190: # Register all the tags with the helper, so the helper can 191: # push and pop them 192: 193: my @helperTags; 194: 195: sub register { 196: my ($namespace, @tags) = @_; 197: 198: for my $tag (@tags) { 199: push @helperTags, [$namespace, $tag]; 200: } 201: } 202: 203: BEGIN { 204: Apache::lonxml::register('Apache::lonhelper', 205: ('helper')); 206: register('Apache::lonhelper', ('state')); 207: } 208: 209: # Since all helpers are only three levels deep (helper tag, state tag, 210: # substate type), it's easier and more readble to explicitly track 211: # those three things directly, rather then futz with the tag stack 212: # every time. 213: my $helper; 214: my $state; 215: my $substate; 216: # To collect parameters, the contents of the subtags are collected 217: # into this paramHash, then passed to the element object when the 218: # end of the element tag is located. 219: my $paramHash; 220: 221: # Note from Jeremy 5-8-2003: It is *vital* that the real handler be called 222: # as a subroutine from the handler, or very mysterious things might happen. 223: # I don't know exactly why, but it seems that the scope where the Apache 224: # server enters the perl handler is treated differently from the rest of 225: # the handler. This also seems to manifest itself in the debugger as entering 226: # the perl handler in seemingly random places (sometimes it starts in the 227: # compiling phase, sometimes in the handler execution phase where it runs 228: # the code and stepping into the "1;" the module ends with goes into the handler, 229: # sometimes starting directly with the handler); I think the cause is related. 230: # In the debugger, this means that breakpoints are ignored until you step into 231: # a function and get out of what must be a "faked up scope" in the Apache-> 232: # mod_perl connection. In this code, it was manifesting itself in the existence 233: # of two separate file-scoped $helper variables, one set to the value of the 234: # helper in the helper constructor, and one referenced by the handler on the 235: # "$helper->process()" line. Using the debugger, one could actually 236: # see the two different $helper variables, as hashes at completely 237: # different addresses. The second was therefore never set, and was still 238: # undefined when I tried to call process on it. 239: # By pushing the "real handler" down into the "real scope", everybody except the 240: # actual handler function directly below this comment gets the same $helper and 241: # everybody is happy. 242: # The upshot of all of this is that for safety when a handler is using 243: # file-scoped variables in LON-CAPA, the handler should be pushed down one 244: # call level, as I do here, to ensure that the top-level handler function does 245: # not get a different file scope from the rest of the code. 246: sub handler { 247: my $r = shift; 248: return real_handler($r); 249: } 250: 251: # For debugging purposes, one can send a second parameter into this 252: # function, the 'uri' of the helper you wish to have rendered, and 253: # call this from other handlers. 254: sub real_handler { 255: my $r = shift; 256: my $uri = shift; 257: if (!defined($uri)) { $uri = $r->uri(); } 258: $ENV{'request.uri'} = $uri; 259: my $filename = '/home/httpd/html' . $uri; 260: my $fh = Apache::File->new($filename); 261: my $file; 262: read $fh, $file, 100000000; 263: 264: 265: # Send header, don't cache this page 266: if ($ENV{'browser.mathml'}) { 267: &Apache::loncommon::content_type($r,'text/xml'); 268: } else { 269: &Apache::loncommon::content_type($r,'text/html'); 270: } 271: $r->send_http_header; 272: return OK if $r->header_only; 273: $r->rflush(); 274: 275: # Discard result, we just want the objects that get created by the 276: # xml parsing 277: &Apache::lonxml::xmlparse($r, 'helper', $file); 278: 279: my $allowed = $helper->allowedCheck(); 280: if (!$allowed) { 281: $ENV{'user.error.msg'} = $ENV{'request.uri'}.':'.$helper->{REQUIRED_PRIV}. 282: ":0:0:Permission denied to access this helper."; 283: return HTTP_NOT_ACCEPTABLE; 284: } 285: 286: $helper->process(); 287: 288: $r->print($helper->display()); 289: return OK; 290: } 291: 292: sub registerHelperTags { 293: for my $tagList (@helperTags) { 294: Apache::lonxml::register($tagList->[0], $tagList->[1]); 295: } 296: } 297: 298: sub unregisterHelperTags { 299: for my $tagList (@helperTags) { 300: Apache::lonxml::deregister($tagList->[0], $tagList->[1]); 301: } 302: } 303: 304: sub start_helper { 305: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 306: 307: if ($target ne 'helper') { 308: return ''; 309: } 310: 311: registerHelperTags(); 312: 313: Apache::lonhelper::helper->new($token->[2]{'title'}, $token->[2]{'requiredpriv'}); 314: return ''; 315: } 316: 317: sub end_helper { 318: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 319: 320: if ($target ne 'helper') { 321: return ''; 322: } 323: 324: unregisterHelperTags(); 325: 326: return ''; 327: } 328: 329: sub start_state { 330: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 331: 332: if ($target ne 'helper') { 333: return ''; 334: } 335: 336: Apache::lonhelper::state->new($token->[2]{'name'}, 337: $token->[2]{'title'}); 338: return ''; 339: } 340: 341: # Use this to get the param hash from other files. 342: sub getParamHash { 343: return $paramHash; 344: } 345: 346: # Use this to get the helper, if implementing elements in other files 347: # (like lonprintout.pm) 348: sub getHelper { 349: return $helper; 350: } 351: 352: # don't need this, so ignore it 353: sub end_state { 354: return ''; 355: } 356: 357: 1; 358: 359: package Apache::lonhelper::helper; 360: 361: use Digest::MD5 qw(md5_hex); 362: use HTML::Entities(); 363: use Apache::loncommon; 364: use Apache::File; 365: use Apache::lonlocal; 366: 367: sub new { 368: my $proto = shift; 369: my $class = ref($proto) || $proto; 370: my $self = {}; 371: 372: $self->{TITLE} = shift; 373: $self->{REQUIRED_PRIV} = shift; 374: 375: # If there is a state from the previous form, use that. If there is no 376: # state, use the start state parameter. 377: if (defined $ENV{"form.CURRENT_STATE"}) 378: { 379: $self->{STATE} = $ENV{"form.CURRENT_STATE"}; 380: } 381: else 382: { 383: $self->{STATE} = "START"; 384: } 385: 386: $self->{TOKEN} = $ENV{'form.TOKEN'}; 387: # If a token was passed, we load that in. Otherwise, we need to create a 388: # new storage file 389: # Tried to use standard Tie'd hashes, but you can't seem to take a 390: # reference to a tied hash and write to it. I'd call that a wart. 391: if ($self->{TOKEN}) { 392: # Validate the token before trusting it 393: if ($self->{TOKEN} !~ /^[a-f0-9]{32}$/) { 394: # Not legit. Return nothing and let all hell break loose. 395: # User shouldn't be doing that! 396: return undef; 397: } 398: 399: # Get the hash. 400: $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN}); # Note the token is not the literal file 401: 402: my $file = Apache::File->new($self->{FILENAME}); 403: my $contents = <$file>; 404: 405: # Now load in the contents 406: for my $value (split (/&/, $contents)) { 407: my ($name, $value) = split(/=/, $value); 408: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; 409: $self->{VARS}->{$name} = $value; 410: } 411: 412: $file->close(); 413: } else { 414: # Only valid if we're just starting. 415: if ($self->{STATE} ne 'START') { 416: return undef; 417: } 418: # Must create the storage 419: $self->{TOKEN} = md5_hex($ENV{'user.name'} . $ENV{'user.domain'} . 420: time() . rand()); 421: $self->{FILENAME} = $Apache::lonnet::tmpdir . md5_hex($self->{TOKEN}); 422: } 423: 424: # OK, we now have our persistent storage. 425: 426: if (defined $ENV{"form.RETURN_PAGE"}) 427: { 428: $self->{RETURN_PAGE} = $ENV{"form.RETURN_PAGE"}; 429: } 430: else 431: { 432: $self->{RETURN_PAGE} = $ENV{REFERER}; 433: } 434: 435: $self->{STATES} = {}; 436: $self->{DONE} = 0; 437: 438: # Used by various helpers for various things; see lonparm.helper 439: # for an example. 440: $self->{DATA} = {}; 441: 442: $helper = $self; 443: 444: # Establish the $paramHash 445: $paramHash = {}; 446: 447: bless($self, $class); 448: return $self; 449: } 450: 451: # Private function; returns a string to construct the hidden fields 452: # necessary to have the helper track state. 453: sub _saveVars { 454: my $self = shift; 455: my $result = ""; 456: $result .= '<input type="hidden" name="CURRENT_STATE" value="' . 457: HTML::Entities::encode($self->{STATE},'<>&"') . "\" />\n"; 458: $result .= '<input type="hidden" name="TOKEN" value="' . 459: $self->{TOKEN} . "\" />\n"; 460: $result .= '<input type="hidden" name="RETURN_PAGE" value="' . 461: HTML::Entities::encode($self->{RETURN_PAGE},'<>&"') . "\" />\n"; 462: 463: return $result; 464: } 465: 466: # Private function: Create the querystring-like representation of the stored 467: # data to write to disk. 468: sub _varsInFile { 469: my $self = shift; 470: my @vars = (); 471: for my $key (keys %{$self->{VARS}}) { 472: push @vars, &Apache::lonnet::escape($key) . '=' . 473: &Apache::lonnet::escape($self->{VARS}->{$key}); 474: } 475: return join ('&', @vars); 476: } 477: 478: # Use this to declare variables. 479: # FIXME: Document this 480: sub declareVar { 481: my $self = shift; 482: my $var = shift; 483: 484: if (!defined($self->{VARS}->{$var})) { 485: $self->{VARS}->{$var} = ''; 486: } 487: 488: my $envname = 'form.' . $var . '.forminput'; 489: if (defined($ENV{$envname})) { 490: if (ref($ENV{$envname})) { 491: $self->{VARS}->{$var} = join('|||', @{$ENV{$envname}}); 492: } else { 493: $self->{VARS}->{$var} = $ENV{$envname}; 494: } 495: } 496: } 497: 498: sub allowedCheck { 499: my $self = shift; 500: 501: if (!defined($self->{REQUIRED_PRIV})) { 502: return 1; 503: } 504: 505: return Apache::lonnet::allowed($self->{REQUIRED_PRIV}, $ENV{'request.course.id'}); 506: } 507: 508: sub changeState { 509: my $self = shift; 510: $self->{STATE} = shift; 511: } 512: 513: sub registerState { 514: my $self = shift; 515: my $state = shift; 516: 517: my $stateName = $state->name(); 518: $self->{STATES}{$stateName} = $state; 519: } 520: 521: sub process { 522: my $self = shift; 523: 524: # Phase 1: Post processing for state of previous screen (which is actually 525: # the "current state" in terms of the helper variables), if it wasn't the 526: # beginning state. 527: if ($self->{STATE} ne "START" || $ENV{"form.SUBMIT"} eq &mt("Next ->")) { 528: my $prevState = $self->{STATES}{$self->{STATE}}; 529: $prevState->postprocess(); 530: } 531: 532: # Note, to handle errors in a state's input that a user must correct, 533: # do not transition in the postprocess, and force the user to correct 534: # the error. 535: 536: # Phase 2: Preprocess current state 537: my $startState = $self->{STATE}; 538: my $state = $self->{STATES}->{$startState}; 539: 540: # For debugging, print something here to determine if you're going 541: # to an undefined state. 542: if (!defined($state)) { 543: return; 544: } 545: $state->preprocess(); 546: 547: # Phase 3: While the current state is different from the previous state, 548: # keep processing. 549: while ( $startState ne $self->{STATE} && 550: defined($self->{STATES}->{$self->{STATE}}) ) 551: { 552: $startState = $self->{STATE}; 553: $state = $self->{STATES}->{$startState}; 554: $state->preprocess(); 555: } 556: 557: return; 558: } 559: 560: # 1: Do the post processing for the previous state. 561: # 2: Do the preprocessing for the current state. 562: # 3: Check to see if state changed, if so, postprocess current and move to next. 563: # Repeat until state stays stable. 564: # 4: Render the current state to the screen as an HTML page. 565: sub display { 566: my $self = shift; 567: 568: my $state = $self->{STATES}{$self->{STATE}}; 569: 570: my $result = ""; 571: 572: if (!defined($state)) { 573: $result = "<font color='#ff0000'>Error: state '$state' not defined!</font>"; 574: return $result; 575: } 576: 577: # Phase 4: Display. 578: my $stateTitle=&mt($state->title()); 579: my $helperTitle = &mt($self->{TITLE}); 580: my $bodytag = &Apache::loncommon::bodytag($helperTitle,'',''); 581: my $previous = HTML::Entities::encode(&mt("<- Previous"), '<>&"'); 582: my $next = HTML::Entities::encode(&mt("Next ->"), '<>&"'); 583: # FIXME: This should be parameterized, not concatenated - Jeremy 584: my $loncapaHelper = &mt("LON-CAPA Helper:"); 585: 586: $result .= <<HEADER; 587: <html> 588: <head> 589: <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> 590: <title>$loncapaHelper: $helperTitle</title> 591: </head> 592: $bodytag 593: HEADER 594: if (!$state->overrideForm()) { $result.="<form name='helpform' method='POST'>"; } 595: $result .= <<HEADER; 596: <table border="0" width='100%'><tr><td> 597: <h2><i>$stateTitle</i></h2> 598: HEADER 599: 600: $result .= "<table cellpadding='10' width='100%'><tr><td rowspan='2' valign='top'>"; 601: 602: if (!$state->overrideForm()) { 603: $result .= $self->_saveVars(); 604: } 605: $result .= $state->render(); 606: 607: $result .= "</td><td valign='top' align='right'>"; 608: 609: # Warning: Copy and pasted from below, because it's too much trouble to 610: # turn this into a subroutine 611: if (!$state->overrideForm()) { 612: if ($self->{STATE} ne $self->{START_STATE}) { 613: #$result .= '<input name="SUBMIT" type="submit" value="<- Previous" /> '; 614: } 615: if ($self->{DONE}) { 616: my $returnPage = $self->{RETURN_PAGE}; 617: $result .= "<a href=\"$returnPage\">" . &mt("End Helper") . "</a>"; 618: } 619: else { 620: $result .= '<nobr><input name="back" type="button" '; 621: $result .= 'value="' . $previous . '" onclick="history.go(-1)" /> '; 622: $result .= '<input name="SUBMIT" type="submit" value="' . $next . '" /></nobr>'; 623: } 624: } 625: 626: $result .= "</td></tr><tr><td valign='bottom' align='right'>"; 627: 628: # Warning: Copy and pasted from above, because it's too much trouble to 629: # turn this into a subroutine 630: if (!$state->overrideForm()) { 631: if ($self->{STATE} ne $self->{START_STATE}) { 632: #$result .= '<input name="SUBMIT" type="submit" value="<- Previous" /> '; 633: } 634: if ($self->{DONE}) { 635: my $returnPage = $self->{RETURN_PAGE}; 636: $result .= "<a href=\"$returnPage\">" . &mt('End Helper') . "</a>"; 637: } 638: else { 639: $result .= '<nobr><input name="back" type="button" '; 640: $result .= 'value="' . $previous . '" onclick="history.go(-1)" /> '; 641: $result .= '<input name="SUBMIT" type="submit" value="' . $next . '" /></nobr>'; 642: } 643: } 644: 645: #foreach my $key (keys %{$self->{VARS}}) { 646: # $result .= "|$key| -> " . $self->{VARS}->{$key} . "<br />"; 647: #} 648: 649: $result .= "</td></tr></table>"; 650: 651: $result .= <<FOOTER; 652: </td> 653: </tr> 654: </table> 655: </form> 656: </body> 657: </html> 658: FOOTER 659: 660: # Handle writing out the vars to the file 661: my $file = Apache::File->new('>'.$self->{FILENAME}); 662: print $file $self->_varsInFile(); 663: 664: return $result; 665: } 666: 667: 1; 668: 669: package Apache::lonhelper::state; 670: 671: # States bundle things together and are responsible for compositing the 672: # various elements together. It is not generally necessary for users to 673: # use the state object directly, so it is not perldoc'ed. 674: 675: # Basically, all the states do is pass calls to the elements and aggregate 676: # the results. 677: 678: sub new { 679: my $proto = shift; 680: my $class = ref($proto) || $proto; 681: my $self = {}; 682: 683: $self->{NAME} = shift; 684: $self->{TITLE} = shift; 685: $self->{ELEMENTS} = []; 686: 687: bless($self, $class); 688: 689: $helper->registerState($self); 690: 691: $state = $self; 692: 693: return $self; 694: } 695: 696: sub name { 697: my $self = shift; 698: return $self->{NAME}; 699: } 700: 701: sub title { 702: my $self = shift; 703: return $self->{TITLE}; 704: } 705: 706: sub preprocess { 707: my $self = shift; 708: for my $element (@{$self->{ELEMENTS}}) { 709: $element->preprocess(); 710: } 711: } 712: 713: # FIXME: Document that all postprocesses must return a true value or 714: # the state transition will be overridden 715: sub postprocess { 716: my $self = shift; 717: 718: # Save the state so we can roll it back if we need to. 719: my $originalState = $helper->{STATE}; 720: my $everythingSuccessful = 1; 721: 722: for my $element (@{$self->{ELEMENTS}}) { 723: my $result = $element->postprocess(); 724: if (!$result) { $everythingSuccessful = 0; } 725: } 726: 727: # If not all the postprocesses were successful, override 728: # any state transitions that may have occurred. It is the 729: # responsibility of the states to make sure they have 730: # error handling in that case. 731: if (!$everythingSuccessful) { 732: $helper->{STATE} = $originalState; 733: } 734: } 735: 736: # Override the form if any element wants to. 737: # two elements overriding the form will make a mess, but that should 738: # be considered helper author error ;-) 739: sub overrideForm { 740: my $self = shift; 741: for my $element (@{$self->{ELEMENTS}}) { 742: if ($element->overrideForm()) { 743: return 1; 744: } 745: } 746: return 0; 747: } 748: 749: sub addElement { 750: my $self = shift; 751: my $element = shift; 752: 753: push @{$self->{ELEMENTS}}, $element; 754: } 755: 756: sub render { 757: my $self = shift; 758: my @results = (); 759: 760: for my $element (@{$self->{ELEMENTS}}) { 761: push @results, $element->render(); 762: } 763: 764: return join("\n", @results); 765: } 766: 767: 1; 768: 769: package Apache::lonhelper::element; 770: # Support code for elements 771: 772: =pod 773: 774: =head1 Element Base Class 775: 776: The Apache::lonhelper::element base class provides support for elements 777: and defines some generally useful tags for use in elements. 778: 779: =head2 finalcode tagX<finalcode> 780: 781: Each element can contain a "finalcode" tag that, when the special FINAL 782: helper state is used, will be executed, surrounded by "sub { my $helper = shift;" 783: and "}". It is expected to return a string describing what it did, which 784: may be an empty string. See course initialization helper for an example. This is 785: generally intended for helpers like the course initialization helper, which consist 786: of several panels, each of which is performing some sort of bite-sized functionality. 787: 788: =head2 defaultvalue tagX<defaultvalue> 789: 790: Each element that accepts user input can contain a "defaultvalue" tag that, 791: when surrounded by "sub { my $helper = shift; my $state = shift; " and "}", 792: will form a subroutine that when called will provide a default value for 793: the element. How this value is interpreted by the element is specific to 794: the element itself, and possibly the settings the element has (such as 795: multichoice vs. single choice for <choices> tags). 796: 797: This is also intended for things like the course initialization wizard, where the 798: user is setting various parameters. By correctly grabbing current settings 799: and including them into the helper, it allows the user to come back to the 800: helper later and re-execute it, without needing to worry about overwriting 801: some setting accidentally. 802: 803: Again, see the course initialization helper for examples. 804: 805: =head2 validator tagX<validator> 806: 807: Some elements that accepts user input can contain a "validator" tag that, 808: when surrounded by "sub { my $helper = shift; my $state = shift; my $element = shift; my $val = shift " 809: and "}", where "$val" is the value the user entered, will form a subroutine 810: that when called will verify whether the given input is valid or not. If it 811: is valid, the routine will return a false value. If invalid, the routine 812: will return an error message to be displayed for the user. 813: 814: Consult the documentation for each element to see whether it supports this 815: tag. 816: 817: =head2 getValue methodX<getValue (helper elements)> 818: 819: If the element stores the name of the variable in a 'variable' member, which 820: the provided ones all do, you can retreive the value of the variable by calling 821: this method. 822: 823: =cut 824: 825: BEGIN { 826: &Apache::lonhelper::register('Apache::lonhelper::element', 827: ('nextstate', 'finalcode', 828: 'defaultvalue', 'validator')); 829: } 830: 831: # Because we use the param hash, this is often a sufficent 832: # constructor 833: sub new { 834: my $proto = shift; 835: my $class = ref($proto) || $proto; 836: my $self = $paramHash; 837: bless($self, $class); 838: 839: $self->{PARAMS} = $paramHash; 840: $self->{STATE} = $state; 841: $state->addElement($self); 842: 843: # Ensure param hash is not reused 844: $paramHash = {}; 845: 846: return $self; 847: } 848: 849: sub start_nextstate { 850: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 851: 852: if ($target ne 'helper') { 853: return ''; 854: } 855: 856: $paramHash->{NEXTSTATE} = &Apache::lonxml::get_all_text('/nextstate', 857: $parser); 858: return ''; 859: } 860: 861: sub end_nextstate { return ''; } 862: 863: sub start_finalcode { 864: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 865: 866: if ($target ne 'helper') { 867: return ''; 868: } 869: 870: $paramHash->{FINAL_CODE} = &Apache::lonxml::get_all_text('/finalcode', 871: $parser); 872: return ''; 873: } 874: 875: sub end_finalcode { return ''; } 876: 877: sub start_defaultvalue { 878: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 879: 880: if ($target ne 'helper') { 881: return ''; 882: } 883: 884: $paramHash->{DEFAULT_VALUE} = &Apache::lonxml::get_all_text('/defaultvalue', 885: $parser); 886: $paramHash->{DEFAULT_VALUE} = 'sub { my $helper = shift; my $state = shift;' . 887: $paramHash->{DEFAULT_VALUE} . '}'; 888: return ''; 889: } 890: 891: sub end_defaultvalue { return ''; } 892: 893: # Validators may need to take language specifications 894: sub start_validator { 895: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 896: 897: if ($target ne 'helper') { 898: return ''; 899: } 900: 901: $paramHash->{VALIDATOR} = &Apache::lonxml::get_all_text('/validator', 902: $parser); 903: $paramHash->{VALIDATOR} = 'sub { my $helper = shift; my $state = shift; my $element = shift; my $val = shift;' . 904: $paramHash->{VALIDATOR} . '}'; 905: return ''; 906: } 907: 908: sub end_validator { return ''; } 909: 910: sub preprocess { 911: return 1; 912: } 913: 914: sub postprocess { 915: return 1; 916: } 917: 918: sub render { 919: return ''; 920: } 921: 922: sub overrideForm { 923: return 0; 924: } 925: 926: sub getValue { 927: my $self = shift; 928: return $helper->{VARS}->{$self->{'variable'}}; 929: } 930: 931: 1; 932: 933: package Apache::lonhelper::message; 934: 935: =pod 936: 937: =head1 Elements 938: 939: =head2 Element: messageX<message, helper element> 940: 941: Message elements display their contents, and 942: transition directly to the state in the <nextstate> attribute. Example: 943: 944: <message nextstate='GET_NAME'> 945: This is the <b>message</b> the user will see, 946: <i>HTML allowed</i>. 947: </message> 948: 949: This will display the HTML message and transition to the 'nextstate' if 950: given. The HTML will be directly inserted into the helper, so if you don't 951: want text to run together, you'll need to manually wrap the message text 952: in <p> tags, or whatever is appropriate for your HTML. 953: 954: Message tags do not add in whitespace, so if you want it, you'll need to add 955: it into states. This is done so you can inline some elements, such as 956: the <date> element, right between two messages, giving the appearence that 957: the <date> element appears inline. (Note the elements can not be embedded 958: within each other.) 959: 960: This is also a good template for creating your own new states, as it has 961: very little code beyond the state template. 962: 963: =head3 Localization 964: 965: The contents of the message tag will be run through the 966: normalize_string function and that will be used as a call to &mt. 967: 968: =cut 969: 970: no strict; 971: @ISA = ("Apache::lonhelper::element"); 972: use strict; 973: use Apache::lonlocal; 974: 975: BEGIN { 976: &Apache::lonhelper::register('Apache::lonhelper::message', 977: ('message')); 978: } 979: 980: sub new { 981: my $ref = Apache::lonhelper::element->new(); 982: bless($ref); 983: } 984: 985: # CONSTRUCTION: Construct the message element from the XML 986: sub start_message { 987: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 988: 989: if ($target ne 'helper') { 990: return ''; 991: } 992: 993: $paramHash->{MESSAGE_TEXT} = &mtn(&Apache::lonxml::get_all_text('/message', 994: $parser)); 995: 996: if (defined($token->[2]{'nextstate'})) { 997: $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'}; 998: } 999: return ''; 1000: } 1001: 1002: sub end_message { 1003: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1004: 1005: if ($target ne 'helper') { 1006: return ''; 1007: } 1008: Apache::lonhelper::message->new(); 1009: return ''; 1010: } 1011: 1012: sub render { 1013: my $self = shift; 1014: 1015: return &mtn($self->{MESSAGE_TEXT}); 1016: } 1017: # If a NEXTSTATE was given, switch to it 1018: sub postprocess { 1019: my $self = shift; 1020: if (defined($self->{NEXTSTATE})) { 1021: $helper->changeState($self->{NEXTSTATE}); 1022: } 1023: 1024: return 1; 1025: } 1026: 1; 1027: 1028: package Apache::lonhelper::choices; 1029: 1030: =pod 1031: 1032: =head2 Element: choicesX<choices, helper element> 1033: 1034: Choice states provide a single choice to the user as a text selection box. 1035: A "choice" is two pieces of text, one which will be displayed to the user 1036: (the "human" value), and one which will be passed back to the program 1037: (the "computer" value). For instance, a human may choose from a list of 1038: resources on disk by title, while your program wants the file name. 1039: 1040: <choices> takes an attribute "variable" to control which helper variable 1041: the result is stored in. 1042: 1043: <choices> takes an attribute "multichoice" which, if set to a true 1044: value, will allow the user to select multiple choices. 1045: 1046: <choices> takes an attribute "allowempty" which, if set to a true 1047: value, will allow the user to select none of the choices without raising 1048: an error message. 1049: 1050: =head3 SUB-TAGS 1051: 1052: <choices> can have the following subtags:X<choice, helper tag> 1053: 1054: =over 4 1055: 1056: =item * <nextstate>state_name</nextstate>: If given, this will cause the 1057: choice element to transition to the given state after executing. 1058: This will override the <nextstate> passed to <choices> (if any). 1059: 1060: =item * <choice />: If the choices are static, 1061: this element will allow you to specify them. Each choice 1062: contains attribute, "computer", as described above. The 1063: content of the tag will be used as the human label. 1064: For example, 1065: <choice computer='234-12-7312'>Bobby McDormik</choice>. 1066: 1067: <choice> can take a parameter "eval", which if set to 1068: a true value, will cause the contents of the tag to be 1069: evaluated as it would be in an <eval> tag; see <eval> tag 1070: below. 1071: 1072: <choice> may optionally contain a 'nextstate' attribute, which 1073: will be the state transistioned to if the choice is made, if 1074: the choice is not multichoice. This will override the nextstate 1075: passed to the parent C<choices> tag. 1076: 1077: =back 1078: 1079: To create the choices programmatically, either wrap the choices in 1080: <condition> tags (prefered), or use an <exec> block inside the <choice> 1081: tag. Store the choices in $state->{CHOICES}, which is a list of list 1082: references, where each list has three strings. The first is the human 1083: name, the second is the computer name. and the third is the option 1084: next state. For example: 1085: 1086: <exec> 1087: for (my $i = 65; $i < 65 + 26; $i++) { 1088: push @{$state->{CHOICES}}, [chr($i), $i, 'next']; 1089: } 1090: </exec> 1091: 1092: This will allow the user to select from the letters A-Z (in ASCII), while 1093: passing the ASCII value back into the helper variables, and the state 1094: will in all cases transition to 'next'. 1095: 1096: You can mix and match methods of creating choices, as long as you always 1097: "push" onto the choice list, rather then wiping it out. (You can even 1098: remove choices programmatically, but that would probably be bad form.) 1099: 1100: =head3 defaultvalue support 1101: 1102: Choices supports default values both in multichoice and single choice mode. 1103: In single choice mode, have the defaultvalue tag's function return the 1104: computer value of the box you want checked. If the function returns a value 1105: that does not correspond to any of the choices, the default behavior of selecting 1106: the first choice will be preserved. 1107: 1108: For multichoice, return a string with the computer values you want checked, 1109: delimited by triple pipes. Note this matches how the result of the <choices> 1110: tag is stored in the {VARS} hash. 1111: 1112: =cut 1113: 1114: no strict; 1115: @ISA = ("Apache::lonhelper::element"); 1116: use strict; 1117: use Apache::lonlocal; 1118: 1119: BEGIN { 1120: &Apache::lonhelper::register('Apache::lonhelper::choices', 1121: ('choice', 'choices')); 1122: } 1123: 1124: sub new { 1125: my $ref = Apache::lonhelper::element->new(); 1126: bless($ref); 1127: } 1128: 1129: # CONSTRUCTION: Construct the message element from the XML 1130: sub start_choices { 1131: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1132: 1133: if ($target ne 'helper') { 1134: return ''; 1135: } 1136: 1137: # Need to initialize the choices list, so everything can assume it exists 1138: $paramHash->{'variable'} = $token->[2]{'variable'} if (!defined($paramHash->{'variable'})); 1139: $helper->declareVar($paramHash->{'variable'}); 1140: $paramHash->{'multichoice'} = $token->[2]{'multichoice'}; 1141: $paramHash->{'allowempty'} = $token->[2]{'allowempty'}; 1142: $paramHash->{CHOICES} = []; 1143: return ''; 1144: } 1145: 1146: sub end_choices { 1147: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1148: 1149: if ($target ne 'helper') { 1150: return ''; 1151: } 1152: Apache::lonhelper::choices->new(); 1153: return ''; 1154: } 1155: 1156: sub start_choice { 1157: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1158: 1159: if ($target ne 'helper') { 1160: return ''; 1161: } 1162: 1163: my $computer = $token->[2]{'computer'}; 1164: my $human = &mt(&Apache::lonxml::get_all_text('/choice', 1165: $parser)); 1166: my $nextstate = $token->[2]{'nextstate'}; 1167: my $evalFlag = $token->[2]{'eval'}; 1168: push @{$paramHash->{CHOICES}}, [$human, $computer, $nextstate, 1169: $evalFlag]; 1170: return ''; 1171: } 1172: 1173: sub end_choice { 1174: return ''; 1175: } 1176: 1177: sub render { 1178: my $self = shift; 1179: my $var = $self->{'variable'}; 1180: my $buttons = ''; 1181: my $result = ''; 1182: 1183: if ($self->{'multichoice'}) { 1184: $result .= <<SCRIPT; 1185: <script> 1186: function checkall(value, checkName) { 1187: for (i=0; i<document.forms.helpform.elements.length; i++) { 1188: ele = document.forms.helpform.elements[i]; 1189: if (ele.name == checkName + '.forminput') { 1190: document.forms.helpform.elements[i].checked=value; 1191: } 1192: } 1193: } 1194: </script> 1195: SCRIPT 1196: } 1197: 1198: # Only print "select all" and "unselect all" if there are five or 1199: # more choices; fewer then that and it looks silly. 1200: if ($self->{'multichoice'} && scalar(@{$self->{CHOICES}}) > 4) { 1201: my %lt=&Apache::lonlocal::texthash( 1202: 'sa' => "Select All", 1203: 'ua' => "Unselect All"); 1204: $buttons = <<BUTTONS; 1205: <br /> 1206: <input type="button" onclick="checkall(true, '$var')" value="$lt{'sa'}" /> 1207: <input type="button" onclick="checkall(false, '$var')" value="$lt{'ua'}" /> 1208: <br /> 1209: BUTTONS 1210: } 1211: 1212: if (defined $self->{ERROR_MSG}) { 1213: $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br />'; 1214: } 1215: 1216: $result .= $buttons; 1217: 1218: $result .= "<table>\n\n"; 1219: 1220: my %checkedChoices; 1221: my $checkedChoicesFunc; 1222: 1223: if (defined($self->{DEFAULT_VALUE})) { 1224: $checkedChoicesFunc = eval ($self->{DEFAULT_VALUE}); 1225: die 'Error in default value code for variable ' . 1226: $self->{'variable'} . ', Perl said: ' . $@ if $@; 1227: } else { 1228: $checkedChoicesFunc = sub { return ''; }; 1229: } 1230: 1231: # Process which choices should be checked. 1232: if ($self->{'multichoice'}) { 1233: for my $selectedChoice (split(/\|\|\|/, (&$checkedChoicesFunc($helper, $self)))) { 1234: $checkedChoices{$selectedChoice} = 1; 1235: } 1236: } else { 1237: # single choice 1238: my $selectedChoice = &$checkedChoicesFunc($helper, $self); 1239: 1240: my $foundChoice = 0; 1241: 1242: # check that the choice is in the list of choices. 1243: for my $choice (@{$self->{CHOICES}}) { 1244: if ($choice->[1] eq $selectedChoice) { 1245: $checkedChoices{$choice->[1]} = 1; 1246: $foundChoice = 1; 1247: } 1248: } 1249: 1250: # If we couldn't find the choice, pick the first one 1251: if (!$foundChoice) { 1252: $checkedChoices{$self->{CHOICES}->[0]->[1]} = 1; 1253: } 1254: } 1255: 1256: my $type = "radio"; 1257: if ($self->{'multichoice'}) { $type = 'checkbox'; } 1258: foreach my $choice (@{$self->{CHOICES}}) { 1259: $result .= "<tr>\n<td width='20'> </td>\n"; 1260: $result .= "<td valign='top'><input type='$type' name='$var.forminput'" 1261: . "' value='" . 1262: HTML::Entities::encode($choice->[1],'<>&"') 1263: . "'"; 1264: if ($checkedChoices{$choice->[1]}) { 1265: $result .= " checked "; 1266: } 1267: my $choiceLabel = $choice->[0]; 1268: if ($choice->[4]) { # if we need to evaluate this choice 1269: $choiceLabel = "sub { my $helper = shift; my $state = shift;" . 1270: $choiceLabel . "}"; 1271: $choiceLabel = eval($choiceLabel); 1272: $choiceLabel = &$choiceLabel($helper, $self); 1273: } 1274: &Apache::lonnet::logthis("TITLE TRANSLATION >$choiceLabel<"); 1275: $result .= "/></td><td> " . &mtn($choiceLabel) . "</td></tr>\n"; 1276: } 1277: $result .= "</table>\n\n\n"; 1278: $result .= $buttons; 1279: 1280: return $result; 1281: } 1282: 1283: # If a NEXTSTATE was given or a nextstate for this choice was 1284: # given, switch to it 1285: sub postprocess { 1286: my $self = shift; 1287: my $chosenValue = $ENV{'form.' . $self->{'variable'} . '.forminput'}; 1288: 1289: if (!defined($chosenValue) && !$self->{'allowempty'}) { 1290: $self->{ERROR_MSG} = 1291: &mt("You must choose one or more choices to continue."); 1292: return 0; 1293: } 1294: 1295: if (ref($chosenValue)) { 1296: $helper->{VARS}->{$self->{'variable'}} = join('|||', @$chosenValue); 1297: } 1298: 1299: if (defined($self->{NEXTSTATE})) { 1300: $helper->changeState($self->{NEXTSTATE}); 1301: } 1302: 1303: foreach my $choice (@{$self->{CHOICES}}) { 1304: if ($choice->[1] eq $chosenValue) { 1305: if (defined($choice->[2])) { 1306: $helper->changeState($choice->[2]); 1307: } 1308: } 1309: } 1310: return 1; 1311: } 1312: 1; 1313: 1314: package Apache::lonhelper::dropdown; 1315: 1316: =pod 1317: 1318: =head2 Element: dropdownX<dropdown, helper tag> 1319: 1320: A drop-down provides a drop-down box instead of a radio button 1321: box. Because most people do not know how to use a multi-select 1322: drop-down box, that option is not allowed. Otherwise, the arguments 1323: are the same as "choices", except "allowempty" is also meaningless. 1324: 1325: <dropdown> takes an attribute "variable" to control which helper variable 1326: the result is stored in. 1327: 1328: =head3 SUB-TAGS 1329: 1330: <choice>, which acts just as it does in the "choices" element. 1331: 1332: =cut 1333: 1334: # This really ought to be a sibling class to "choice" which is itself 1335: # a child of some abstract class.... *shrug* 1336: 1337: no strict; 1338: @ISA = ("Apache::lonhelper::element"); 1339: use strict; 1340: use Apache::lonlocal; 1341: 1342: BEGIN { 1343: &Apache::lonhelper::register('Apache::lonhelper::dropdown', 1344: ('dropdown')); 1345: } 1346: 1347: sub new { 1348: my $ref = Apache::lonhelper::element->new(); 1349: bless($ref); 1350: } 1351: 1352: # CONSTRUCTION: Construct the message element from the XML 1353: sub start_dropdown { 1354: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1355: 1356: if ($target ne 'helper') { 1357: return ''; 1358: } 1359: 1360: # Need to initialize the choices list, so everything can assume it exists 1361: $paramHash->{'variable'} = $token->[2]{'variable'} if (!defined($paramHash->{'variable'})); 1362: $helper->declareVar($paramHash->{'variable'}); 1363: $paramHash->{CHOICES} = []; 1364: return ''; 1365: } 1366: 1367: sub end_dropdown { 1368: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1369: 1370: if ($target ne 'helper') { 1371: return ''; 1372: } 1373: Apache::lonhelper::dropdown->new(); 1374: return ''; 1375: } 1376: 1377: sub render { 1378: my $self = shift; 1379: my $var = $self->{'variable'}; 1380: my $result = ''; 1381: 1382: if (defined $self->{ERROR_MSG}) { 1383: $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br />'; 1384: } 1385: 1386: my %checkedChoices; 1387: my $checkedChoicesFunc; 1388: 1389: if (defined($self->{DEFAULT_VALUE})) { 1390: $checkedChoicesFunc = eval ($self->{DEFAULT_VALUE}); 1391: die 'Error in default value code for variable ' . 1392: $self->{'variable'} . ', Perl said: ' . $@ if $@; 1393: } else { 1394: $checkedChoicesFunc = sub { return ''; }; 1395: } 1396: 1397: # single choice 1398: my $selectedChoice = &$checkedChoicesFunc($helper, $self); 1399: 1400: my $foundChoice = 0; 1401: 1402: # check that the choice is in the list of choices. 1403: for my $choice (@{$self->{CHOICES}}) { 1404: if ($choice->[1] eq $selectedChoice) { 1405: $checkedChoices{$choice->[1]} = 1; 1406: $foundChoice = 1; 1407: } 1408: } 1409: 1410: # If we couldn't find the choice, pick the first one 1411: if (!$foundChoice) { 1412: $checkedChoices{$self->{CHOICES}->[0]->[1]} = 1; 1413: } 1414: 1415: $result .= "<select name='${var}.forminput'>\n"; 1416: foreach my $choice (@{$self->{CHOICES}}) { 1417: $result .= "<option value='" . 1418: HTML::Entities::encode($choice->[1],'<>&"') 1419: . "'"; 1420: if ($checkedChoices{$choice->[1]}) { 1421: $result .= " selected"; 1422: } 1423: my $choiceLabel = $choice->[0]; 1424: if ($choice->[4]) { # if we need to evaluate this choice 1425: $choiceLabel = "sub { my $helper = shift; my $state = shift;" . 1426: $choiceLabel . "}"; 1427: $choiceLabel = eval($choiceLabel); 1428: $choiceLabel = &$choiceLabel($helper, $self); 1429: } 1430: $result .= ">" . &mtn($choiceLabel) . "\n"; 1431: } 1432: $result .= "</select>\n"; 1433: 1434: return $result; 1435: } 1436: 1437: # If a NEXTSTATE was given or a nextstate for this choice was 1438: # given, switch to it 1439: sub postprocess { 1440: my $self = shift; 1441: my $chosenValue = $ENV{'form.' . $self->{'variable'} . '.forminput'}; 1442: 1443: if (!defined($chosenValue) && !$self->{'allowempty'}) { 1444: $self->{ERROR_MSG} = "You must choose one or more choices to" . 1445: " continue."; 1446: return 0; 1447: } 1448: 1449: if (defined($self->{NEXTSTATE})) { 1450: $helper->changeState($self->{NEXTSTATE}); 1451: } 1452: 1453: foreach my $choice (@{$self->{CHOICES}}) { 1454: if ($choice->[1] eq $chosenValue) { 1455: if (defined($choice->[2])) { 1456: $helper->changeState($choice->[2]); 1457: } 1458: } 1459: } 1460: return 1; 1461: } 1462: 1; 1463: 1464: package Apache::lonhelper::date; 1465: 1466: =pod 1467: 1468: =head2 Element: dateX<date, helper element> 1469: 1470: Date elements allow the selection of a date with a drop down list. 1471: 1472: Date elements can take two attributes: 1473: 1474: =over 4 1475: 1476: =item * B<variable>: The name of the variable to store the chosen 1477: date in. Required. 1478: 1479: =item * B<hoursminutes>: If a true value, the date will show hours 1480: and minutes, as well as month/day/year. If false or missing, 1481: the date will only show the month, day, and year. 1482: 1483: =back 1484: 1485: Date elements contain only an option <nextstate> tag to determine 1486: the next state. 1487: 1488: Example: 1489: 1490: <date variable="DUE_DATE" hoursminutes="1"> 1491: <nextstate>choose_why</nextstate> 1492: </date> 1493: 1494: =cut 1495: 1496: no strict; 1497: @ISA = ("Apache::lonhelper::element"); 1498: use strict; 1499: use Apache::lonlocal; # A localization nightmare 1500: 1501: use Time::localtime; 1502: 1503: BEGIN { 1504: &Apache::lonhelper::register('Apache::lonhelper::date', 1505: ('date')); 1506: } 1507: 1508: # Don't need to override the "new" from element 1509: sub new { 1510: my $ref = Apache::lonhelper::element->new(); 1511: bless($ref); 1512: } 1513: 1514: my @months = ("January", "February", "March", "April", "May", "June", "July", 1515: "August", "September", "October", "November", "December"); 1516: 1517: # CONSTRUCTION: Construct the message element from the XML 1518: sub start_date { 1519: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1520: 1521: if ($target ne 'helper') { 1522: return ''; 1523: } 1524: 1525: $paramHash->{'variable'} = $token->[2]{'variable'}; 1526: $helper->declareVar($paramHash->{'variable'}); 1527: $paramHash->{'hoursminutes'} = $token->[2]{'hoursminutes'}; 1528: } 1529: 1530: sub end_date { 1531: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1532: 1533: if ($target ne 'helper') { 1534: return ''; 1535: } 1536: Apache::lonhelper::date->new(); 1537: return ''; 1538: } 1539: 1540: sub render { 1541: my $self = shift; 1542: my $result = ""; 1543: my $var = $self->{'variable'}; 1544: 1545: my $date; 1546: 1547: # Default date: The current hour. 1548: $date = localtime(); 1549: $date->min(0); 1550: 1551: if (defined $self->{ERROR_MSG}) { 1552: $result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />'; 1553: } 1554: 1555: # Month 1556: my $i; 1557: $result .= "<select name='${var}month'>\n"; 1558: for ($i = 0; $i < 12; $i++) { 1559: if ($i == $date->mon) { 1560: $result .= "<option value='$i' selected>"; 1561: } else { 1562: $result .= "<option value='$i'>"; 1563: } 1564: $result .= &mt($months[$i]) . "</option>\n"; 1565: } 1566: $result .= "</select>\n"; 1567: 1568: # Day 1569: $result .= "<select name='${var}day'>\n"; 1570: for ($i = 1; $i < 32; $i++) { 1571: if ($i == $date->mday) { 1572: $result .= '<option selected>'; 1573: } else { 1574: $result .= '<option>'; 1575: } 1576: $result .= "$i</option>\n"; 1577: } 1578: $result .= "</select>,\n"; 1579: 1580: # Year 1581: $result .= "<select name='${var}year'>\n"; 1582: for ($i = 2000; $i < 2030; $i++) { # update this after 64-bit dates 1583: if ($date->year + 1900 == $i) { 1584: $result .= "<option selected>"; 1585: } else { 1586: $result .= "<option>"; 1587: } 1588: $result .= "$i</option>\n"; 1589: } 1590: $result .= "</select>,\n"; 1591: 1592: # Display Hours and Minutes if they are called for 1593: if ($self->{'hoursminutes'}) { 1594: # This needs parameterization for times. 1595: my $am = &mt('a.m.'); 1596: my $pm = &mt('p.m.'); 1597: # Build hour 1598: $result .= "<select name='${var}hour'>\n"; 1599: $result .= "<option " . ($date->hour == 0 ? 'selected ':'') . 1600: " value='0'>" . &mt('midnight') . "</option>\n"; 1601: for ($i = 1; $i < 12; $i++) { 1602: if ($date->hour == $i) { 1603: $result .= "<option selected value='$i'>$i $am</option>\n"; 1604: } else { 1605: $result .= "<option value='$i'>$i $am</option>\n"; 1606: } 1607: } 1608: $result .= "<option " . ($date->hour == 12 ? 'selected ':'') . 1609: " value='12'>" . &mt('noon') . "</option>\n"; 1610: for ($i = 13; $i < 24; $i++) { 1611: my $printedHour = $i - 12; 1612: if ($date->hour == $i) { 1613: $result .= "<option selected value='$i'>$printedHour $pm</option>\n"; 1614: } else { 1615: $result .= "<option value='$i'>$printedHour $pm</option>\n"; 1616: } 1617: } 1618: 1619: $result .= "</select> :\n"; 1620: 1621: $result .= "<select name='${var}minute'>\n"; 1622: for ($i = 0; $i < 60; $i++) { 1623: my $printedMinute = $i; 1624: if ($i < 10) { 1625: $printedMinute = "0" . $printedMinute; 1626: } 1627: if ($date->min == $i) { 1628: $result .= "<option selected>"; 1629: } else { 1630: $result .= "<option>"; 1631: } 1632: $result .= "$printedMinute</option>\n"; 1633: } 1634: $result .= "</select>\n"; 1635: } 1636: 1637: return $result; 1638: 1639: } 1640: # If a NEXTSTATE was given, switch to it 1641: sub postprocess { 1642: my $self = shift; 1643: my $var = $self->{'variable'}; 1644: my $month = $ENV{'form.' . $var . 'month'}; 1645: my $day = $ENV{'form.' . $var . 'day'}; 1646: my $year = $ENV{'form.' . $var . 'year'}; 1647: my $min = 0; 1648: my $hour = 0; 1649: if ($self->{'hoursminutes'}) { 1650: $min = $ENV{'form.' . $var . 'minute'}; 1651: $hour = $ENV{'form.' . $var . 'hour'}; 1652: } 1653: 1654: my $chosenDate; 1655: eval {$chosenDate = Time::Local::timelocal(0, $min, $hour, $day, $month, $year);}; 1656: my $error = $@; 1657: 1658: # Check to make sure that the date was not automatically co-erced into a 1659: # valid date, as we want to flag that as an error 1660: # This happens for "Feb. 31", for instance, which is coerced to March 2 or 1661: # 3, depending on if it's a leap year 1662: my $checkDate = localtime($chosenDate); 1663: 1664: if ($error || $checkDate->mon != $month || $checkDate->mday != $day || 1665: $checkDate->year + 1900 != $year) { 1666: unless (Apache::lonlocal::current_language()== ~/^en/) { 1667: $self->{ERROR_MSG} = &mt("Invalid date entry"); 1668: return 0; 1669: } 1670: # LOCALIZATION FIXME: Needs to be parameterized 1671: $self->{ERROR_MSG} = "Can't use " . $months[$month] . " $day, $year as a " 1672: . "date because it doesn't exist. Please enter a valid date."; 1673: 1674: return 0; 1675: } 1676: 1677: $helper->{VARS}->{$var} = $chosenDate; 1678: 1679: if (defined($self->{NEXTSTATE})) { 1680: $helper->changeState($self->{NEXTSTATE}); 1681: } 1682: 1683: return 1; 1684: } 1685: 1; 1686: 1687: package Apache::lonhelper::resource; 1688: 1689: =pod 1690: 1691: =head2 Element: resourceX<resource, helper element> 1692: 1693: <resource> elements allow the user to select one or multiple resources 1694: from the current course. You can filter out which resources they can view, 1695: and filter out which resources they can select. The course will always 1696: be displayed fully expanded, because of the difficulty of maintaining 1697: selections across folder openings and closings. If this is fixed, then 1698: the user can manipulate the folders. 1699: 1700: <resource> takes the standard variable attribute to control what helper 1701: variable stores the results. It also takes a "multichoice"X<multichoice> attribute, 1702: which controls whether the user can select more then one resource. The 1703: "toponly" attribute controls whether the resource display shows just the 1704: resources in that sequence, or recurses into all sub-sequences, defaulting 1705: to false. The "suppressEmptySequences" attribute reflects the 1706: suppressEmptySequences argument to the render routine, which will cause 1707: folders that have all of their contained resources filtered out to also 1708: be filtered out. The 'addstatus' attribute, if true, will add the icon 1709: and long status display columns to the display. 1710: 1711: =head3 SUB-TAGS 1712: 1713: =over 4 1714: 1715: =item * <filterfunc>X<filterfunc>: If you want to filter what resources are displayed 1716: to the user, use a filter func. The <filterfunc> tag should contain 1717: Perl code that when wrapped with "sub { my $res = shift; " and "}" is 1718: a function that returns true if the resource should be displayed, 1719: and false if it should be skipped. $res is a resource object. 1720: (See Apache::lonnavmaps documentation for information about the 1721: resource object.) 1722: 1723: =item * <choicefunc>X<choicefunc>: Same as <filterfunc>, except that controls whether 1724: the given resource can be chosen. (It is almost always a good idea to 1725: show the user the folders, for instance, but you do not always want to 1726: let the user select them.) 1727: 1728: =item * <nextstate>: Standard nextstate behavior. 1729: 1730: =item * <valuefunc>X<valuefunc>: This function controls what is returned by the resource 1731: when the user selects it. Like filterfunc and choicefunc, it should be 1732: a function fragment that when wrapped by "sub { my $res = shift; " and 1733: "}" returns a string representing what you want to have as the value. By 1734: default, the value will be the resource ID of the object ($res->{ID}). 1735: 1736: =item * <mapurl>X<mapurl>: If the URL of a map is given here, only that map 1737: will be displayed, instead of the whole course. If the attribute 1738: "evaluate" is given and is true, the contents of the mapurl will be 1739: evaluated with "sub { my $helper = shift; my $state = shift;" and 1740: "}", with the return value used as the mapurl. 1741: 1742: =back 1743: 1744: =cut 1745: 1746: no strict; 1747: @ISA = ("Apache::lonhelper::element"); 1748: use strict; 1749: 1750: BEGIN { 1751: &Apache::lonhelper::register('Apache::lonhelper::resource', 1752: ('resource', 'filterfunc', 1753: 'choicefunc', 'valuefunc', 1754: 'mapurl')); 1755: } 1756: 1757: sub new { 1758: my $ref = Apache::lonhelper::element->new(); 1759: bless($ref); 1760: } 1761: 1762: # CONSTRUCTION: Construct the message element from the XML 1763: sub start_resource { 1764: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1765: 1766: if ($target ne 'helper') { 1767: return ''; 1768: } 1769: 1770: $paramHash->{'variable'} = $token->[2]{'variable'}; 1771: $helper->declareVar($paramHash->{'variable'}); 1772: $paramHash->{'multichoice'} = $token->[2]{'multichoice'}; 1773: $paramHash->{'suppressEmptySequences'} = $token->[2]{'suppressEmptySequences'}; 1774: $paramHash->{'toponly'} = $token->[2]{'toponly'}; 1775: $paramHash->{'addstatus'} = $token->[2]{'addstatus'}; 1776: $paramHash->{'closeallpages'} = $token->[2]{'closeallpages'}; 1777: return ''; 1778: } 1779: 1780: sub end_resource { 1781: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1782: 1783: if ($target ne 'helper') { 1784: return ''; 1785: } 1786: if (!defined($paramHash->{FILTER_FUNC})) { 1787: $paramHash->{FILTER_FUNC} = sub {return 1;}; 1788: } 1789: if (!defined($paramHash->{CHOICE_FUNC})) { 1790: $paramHash->{CHOICE_FUNC} = sub {return 1;}; 1791: } 1792: if (!defined($paramHash->{VALUE_FUNC})) { 1793: $paramHash->{VALUE_FUNC} = sub {my $res = shift; return $res->{ID}; }; 1794: } 1795: Apache::lonhelper::resource->new(); 1796: return ''; 1797: } 1798: 1799: sub start_filterfunc { 1800: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1801: 1802: if ($target ne 'helper') { 1803: return ''; 1804: } 1805: 1806: my $contents = Apache::lonxml::get_all_text('/filterfunc', 1807: $parser); 1808: $contents = 'sub { my $res = shift; ' . $contents . '}'; 1809: $paramHash->{FILTER_FUNC} = eval $contents; 1810: } 1811: 1812: sub end_filterfunc { return ''; } 1813: 1814: sub start_choicefunc { 1815: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1816: 1817: if ($target ne 'helper') { 1818: return ''; 1819: } 1820: 1821: my $contents = Apache::lonxml::get_all_text('/choicefunc', 1822: $parser); 1823: $contents = 'sub { my $res = shift; ' . $contents . '}'; 1824: $paramHash->{CHOICE_FUNC} = eval $contents; 1825: } 1826: 1827: sub end_choicefunc { return ''; } 1828: 1829: sub start_valuefunc { 1830: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1831: 1832: if ($target ne 'helper') { 1833: return ''; 1834: } 1835: 1836: my $contents = Apache::lonxml::get_all_text('/valuefunc', 1837: $parser); 1838: $contents = 'sub { my $res = shift; ' . $contents . '}'; 1839: $paramHash->{VALUE_FUNC} = eval $contents; 1840: } 1841: 1842: sub end_valuefunc { return ''; } 1843: 1844: sub start_mapurl { 1845: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1846: 1847: if ($target ne 'helper') { 1848: return ''; 1849: } 1850: 1851: my $contents = Apache::lonxml::get_all_text('/mapurl', 1852: $parser); 1853: $paramHash->{EVAL_MAP_URL} = $token->[2]{'evaluate'}; 1854: $paramHash->{MAP_URL} = $contents; 1855: } 1856: 1857: sub end_mapurl { return ''; } 1858: 1859: # A note, in case I don't get to this before I leave. 1860: # If someone complains about the "Back" button returning them 1861: # to the previous folder state, instead of returning them to 1862: # the previous helper state, the *correct* answer is for the helper 1863: # to keep track of how many times the user has manipulated the folders, 1864: # and feed that to the history.go() call in the helper rendering routines. 1865: # If done correctly, the helper itself can keep track of how many times 1866: # it renders the same states, so it doesn't go in just this state, and 1867: # you can lean on the browser back button to make sure it all chains 1868: # correctly. 1869: # Right now, though, I'm just forcing all folders open. 1870: 1871: sub render { 1872: my $self = shift; 1873: my $result = ""; 1874: my $var = $self->{'variable'}; 1875: my $curVal = $helper->{VARS}->{$var}; 1876: 1877: my $buttons = ''; 1878: 1879: if ($self->{'multichoice'}) { 1880: $result = <<SCRIPT; 1881: <script> 1882: function checkall(value, checkName) { 1883: for (i=0; i<document.forms.helpform.elements.length; i++) { 1884: ele = document.forms.helpform.elements[i]; 1885: if (ele.name == checkName + '.forminput') { 1886: document.forms.helpform.elements[i].checked=value; 1887: } 1888: } 1889: } 1890: </script> 1891: SCRIPT 1892: my %lt=&Apache::lonlocal::texthash( 1893: 'sar' => "Select All Resources", 1894: 'uar' => "Unselect All Resources"); 1895: 1896: $buttons = <<BUTTONS; 1897: <br /> 1898: <input type="button" onclick="checkall(true, '$var')" value="$lt{'sar'}" /> 1899: <input type="button" onclick="checkall(false, '$var')" value="$lt{'uar'}" /> 1900: <br /> 1901: BUTTONS 1902: } 1903: 1904: if (defined $self->{ERROR_MSG}) { 1905: $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />'; 1906: } 1907: 1908: $result .= $buttons; 1909: 1910: my $filterFunc = $self->{FILTER_FUNC}; 1911: my $choiceFunc = $self->{CHOICE_FUNC}; 1912: my $valueFunc = $self->{VALUE_FUNC}; 1913: my $multichoice = $self->{'multichoice'}; 1914: 1915: # Evaluate the map url as needed 1916: my $mapUrl; 1917: if ($self->{EVAL_MAP_URL}) { 1918: my $mapUrlFunc = eval('sub { my $helper = shift; my $state = shift; ' . 1919: $self->{MAP_URL} . '}'); 1920: $mapUrl = &$mapUrlFunc($helper, $self); 1921: } else { 1922: $mapUrl = $self->{MAP_URL}; 1923: } 1924: 1925: # Create the composite function that renders the column on the nav map 1926: # have to admit any language that lets me do this can't be all bad 1927: # - Jeremy (Pythonista) ;-) 1928: my $checked = 0; 1929: my $renderColFunc = sub { 1930: my ($resource, $part, $params) = @_; 1931: 1932: my $inputType; 1933: if ($multichoice) { $inputType = 'checkbox'; } 1934: else {$inputType = 'radio'; } 1935: 1936: if (!&$choiceFunc($resource)) { 1937: return '<td> </td>'; 1938: } else { 1939: my $col = "<td><input type='$inputType' name='${var}.forminput' "; 1940: if (!$checked && !$multichoice) { 1941: $col .= "checked "; 1942: $checked = 1; 1943: } 1944: if ($multichoice) { # all resources start checked; see bug 1174 1945: $col .= "checked "; 1946: $checked = 1; 1947: } 1948: $col .= "value='" . 1949: HTML::Entities::encode(&$valueFunc($resource),'<>&"') 1950: . "' /></td>"; 1951: return $col; 1952: } 1953: }; 1954: 1955: $ENV{'form.condition'} = !$self->{'toponly'}; 1956: my $cols = [$renderColFunc, Apache::lonnavmaps::resource()]; 1957: if ($self->{'addstatus'}) { 1958: push @$cols, (Apache::lonnavmaps::part_status_summary()); 1959: 1960: } 1961: $result .= 1962: &Apache::lonnavmaps::render( { 'cols' => $cols, 1963: 'showParts' => 0, 1964: 'filterFunc' => $filterFunc, 1965: 'resource_no_folder_link' => 1, 1966: 'closeAllPages' => $self->{'closeallpages'}, 1967: 'suppressEmptySequences' => $self->{'suppressEmptySequences'}, 1968: 'iterator_map' => $mapUrl } 1969: ); 1970: 1971: $result .= $buttons; 1972: 1973: return $result; 1974: } 1975: 1976: sub postprocess { 1977: my $self = shift; 1978: 1979: if ($self->{'multichoice'} && !$helper->{VARS}->{$self->{'variable'}}) { 1980: $self->{ERROR_MSG} = 'You must choose at least one resource to continue.'; 1981: return 0; 1982: } 1983: 1984: if (defined($self->{NEXTSTATE})) { 1985: $helper->changeState($self->{NEXTSTATE}); 1986: } 1987: 1988: return 1; 1989: } 1990: 1991: 1; 1992: 1993: package Apache::lonhelper::student; 1994: 1995: =pod 1996: 1997: =head2 Element: studentX<student, helper element> 1998: 1999: Student elements display a choice of students enrolled in the current 2000: course. Currently it is primitive; this is expected to evolve later. 2001: 2002: Student elements take the following attributes: 2003: 2004: =over 4 2005: 2006: =item * B<variable>: 2007: 2008: Does what it usually does: declare which helper variable to put the 2009: result in. 2010: 2011: =item * B<multichoice>: 2012: 2013: If true allows the user to select multiple students. Defaults to false. 2014: 2015: =item * B<coursepersonnel>: 2016: 2017: If true adds the course personnel to the top of the student 2018: selection. Defaults to false. 2019: 2020: =item * B<activeonly>: 2021: 2022: If true, only active students and course personnel will be 2023: shown. Defaults to false. 2024: 2025: =back 2026: 2027: =cut 2028: 2029: no strict; 2030: @ISA = ("Apache::lonhelper::element"); 2031: use strict; 2032: use Apache::lonlocal; 2033: 2034: 2035: BEGIN { 2036: &Apache::lonhelper::register('Apache::lonhelper::student', 2037: ('student')); 2038: } 2039: 2040: sub new { 2041: my $ref = Apache::lonhelper::element->new(); 2042: bless($ref); 2043: } 2044: 2045: sub start_student { 2046: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2047: 2048: if ($target ne 'helper') { 2049: return ''; 2050: } 2051: 2052: $paramHash->{'variable'} = $token->[2]{'variable'}; 2053: $helper->declareVar($paramHash->{'variable'}); 2054: $paramHash->{'multichoice'} = $token->[2]{'multichoice'}; 2055: $paramHash->{'coursepersonnel'} = $token->[2]{'coursepersonnel'}; 2056: $paramHash->{'sctiveonly'} = $token->[2]{'activeonly'}; 2057: if (defined($token->[2]{'nextstate'})) { 2058: $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'}; 2059: } 2060: 2061: } 2062: 2063: sub end_student { 2064: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2065: 2066: if ($target ne 'helper') { 2067: return ''; 2068: } 2069: Apache::lonhelper::student->new(); 2070: } 2071: 2072: sub render { 2073: my $self = shift; 2074: my $result = ''; 2075: my $buttons = ''; 2076: my $var = $self->{'variable'}; 2077: 2078: if ($self->{'multichoice'}) { 2079: $result = <<SCRIPT; 2080: <script> 2081: function checkall(value, checkName) { 2082: for (i=0; i<document.forms.helpform.elements.length; i++) { 2083: ele = document.forms.helpform.elements[i]; 2084: if (ele.name == checkName + '.forminput') { 2085: document.forms.helpform.elements[i].checked=value; 2086: } 2087: } 2088: } 2089: function checksec(value) { 2090: for (i=0; i<document.forms.helpform.elements.length; i++) { 2091: comp = document.forms.helpform.elements.chksec.value; 2092: if (document.forms.helpform.elements[i].value.indexOf(':'+comp+':') != -1) { 2093: document.forms.helpform.elements[i].checked=value; 2094: } 2095: } 2096: } 2097: function checkactive() { 2098: for (i=0; i<document.forms.helpform.elements.length; i++) { 2099: if (document.forms.helpform.elements[i].value.indexOf(':Active') != -1) { 2100: document.forms.helpform.elements[i].checked=true; 2101: } 2102: } 2103: } 2104: </script> 2105: SCRIPT 2106: 2107: my %lt=&Apache::lonlocal::texthash( 2108: 'ocs' => "Select Only Current Students", 2109: 'sas' => "Select All Students", 2110: 'uas' => "Unselect All Students", 2111: 'sfsg' => "Select for Section/Group", 2112: 'ufsg' => "Unselect for Section/Group"); 2113: 2114: $buttons = <<BUTTONS; 2115: <br /> 2116: <input type="button" onclick="checkactive()" value="$lt{'ocs'}" /> 2117: <input type="button" onclick="checkall(true, '$var')" value="$lt{'sas'}" /> 2118: <input type="button" onclick="checkall(false, '$var')" value="$lt{'uas'}" /> 2119: <input type="button" onclick="checksec(true)" value="$lt{'sfsg'}"> 2120: <input type="text" size="5" name="chksec"> 2121: <input type="button" onclick="checksec(false)" value="$lt{'ufsg'}"> 2122: <br /> 2123: BUTTONS 2124: } 2125: 2126: if (defined $self->{ERROR_MSG}) { 2127: $result .= '<font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />'; 2128: } 2129: 2130: my $choices = []; 2131: 2132: # Load up the non-students, if necessary 2133: if ($self->{'coursepersonnel'}) { 2134: my %coursepersonnel = Apache::lonnet::get_course_adv_roles(); 2135: for (sort keys %coursepersonnel) { 2136: for my $role (split /,/, $coursepersonnel{$_}) { 2137: # extract the names so we can sort them 2138: my @people; 2139: 2140: for (split /,/, $role) { 2141: push @people, [split /:/, $role]; 2142: } 2143: 2144: @people = sort { $a->[0] cmp $b->[0] } @people; 2145: 2146: for my $person (@people) { 2147: push @$choices, [join(':', @$person), $person->[0], '', $_]; 2148: } 2149: } 2150: } 2151: } 2152: 2153: # Constants 2154: my $section = Apache::loncoursedata::CL_SECTION(); 2155: my $fullname = Apache::loncoursedata::CL_FULLNAME(); 2156: my $status = Apache::loncoursedata::CL_STATUS(); 2157: 2158: # Load up the students 2159: my $classlist = &Apache::loncoursedata::get_classlist(); 2160: my @keys = keys %{$classlist}; 2161: # Sort by: Section, name 2162: @keys = sort { 2163: if ($classlist->{$a}->[$section] ne $classlist->{$b}->[$section]) { 2164: return $classlist->{$a}->[$section] cmp $classlist->{$b}->[$section]; 2165: } 2166: return $classlist->{$a}->[$fullname] cmp $classlist->{$b}->[$fullname]; 2167: } @keys; 2168: 2169: # username, fullname, section, type 2170: for (@keys) { 2171: # Filter out inactive students if we've set "activeonly" 2172: if (!$self->{'activeonly'} || $classlist->{$_}->[$status] eq 2173: 'Active') { 2174: push @$choices, [$_, $classlist->{$_}->[$fullname], 2175: $classlist->{$_}->[$section], 2176: $classlist->{$_}->[$status], 'Student']; 2177: } 2178: } 2179: 2180: my $name = $self->{'coursepersonnel'} ? &mt('Name') : &mt('Student Name'); 2181: &Apache::lonnet::logthis("THE NAME IS >$name<"); 2182: my $type = 'radio'; 2183: if ($self->{'multichoice'}) { $type = 'checkbox'; } 2184: $result .= "<table cellspacing='2' cellpadding='2' border='0'>\n"; 2185: $result .= "<tr><td></td><td align='center'><b>$name</b></td>". 2186: "<td align='center'><b>" . &mt('Section') . "</b></td>" . 2187: "<td align='center'><b>".&mt('Status')."</b></td>" . 2188: "<td align='center'><b>" . &mt("Role") . "</b></td>" . 2189: "<td align='center'><b>".&mt('Username').":".&mt('Domain')."</b></td></tr>"; 2190: 2191: my $checked = 0; 2192: for my $choice (@$choices) { 2193: $result .= "<tr><td><input type='$type' name='" . 2194: $self->{'variable'} . '.forminput' . "'"; 2195: 2196: if (!$self->{'multichoice'} && !$checked) { 2197: $result .= " checked "; 2198: $checked = 1; 2199: } 2200: $result .= 2201: " value='" . HTML::Entities::encode($choice->[0] . ':' . $choice->[2] . ':' . $choice->[1] . ':' . $choice->[3],'<>&"') 2202: . "' /></td><td>" 2203: . HTML::Entities::encode($choice->[1],'<>&"') 2204: . "</td><td align='center'>" 2205: . HTML::Entities::encode($choice->[2],'<>&"') 2206: . "</td>\n<td>" 2207: . HTML::Entities::encode($choice->[3],'<>&"') 2208: . "</td>\n<td>" 2209: . HTML::Entities::encode($choice->[4],'<>&"') 2210: . "</td>\n<td>" 2211: . HTML::Entities::encode($choice->[0],'<>&"') 2212: . "</td></tr>\n"; 2213: } 2214: 2215: $result .= "</table>\n\n"; 2216: $result .= $buttons; 2217: 2218: return $result; 2219: } 2220: 2221: sub postprocess { 2222: my $self = shift; 2223: 2224: my $result = $ENV{'form.' . $self->{'variable'} . '.forminput'}; 2225: if (!$result) { 2226: $self->{ERROR_MSG} = 2227: &mt('You must choose at least one student to continue.'); 2228: return 0; 2229: } 2230: 2231: if (defined($self->{NEXTSTATE})) { 2232: $helper->changeState($self->{NEXTSTATE}); 2233: } 2234: 2235: return 1; 2236: } 2237: 2238: 1; 2239: 2240: package Apache::lonhelper::files; 2241: 2242: =pod 2243: 2244: =head2 Element: filesX<files, helper element> 2245: 2246: files allows the users to choose files from a given directory on the 2247: server. It is always multichoice and stores the result as a triple-pipe 2248: delimited entry in the helper variables. 2249: 2250: Since it is extremely unlikely that you can actually code a constant 2251: representing the directory you wish to allow the user to search, <files> 2252: takes a subroutine that returns the name of the directory you wish to 2253: have the user browse. 2254: 2255: files accepts the attribute "variable" to control where the files chosen 2256: are put. It accepts the attribute "multichoice" as the other attribute, 2257: defaulting to false, which if true will allow the user to select more 2258: then one choice. 2259: 2260: <files> accepts three subtags: 2261: 2262: =over 4 2263: 2264: =item * B<nextstate>: works as it does with the other tags. 2265: 2266: =item * B<filechoice>: When the contents of this tag are surrounded by 2267: "sub {" and "}", will return a string representing what directory 2268: on the server to allow the user to choose files from. 2269: 2270: =item * B<filefilter>: Should contain Perl code that when surrounded 2271: by "sub { my $filename = shift; " and "}", returns a true value if 2272: the user can pick that file, or false otherwise. The filename 2273: passed to the function will be just the name of the file, with no 2274: path info. By default, a filter function will be used that will 2275: mask out old versions of files. This function is available as 2276: Apache::lonhelper::files::not_old_version if you want to use it to 2277: composite your own filters. 2278: 2279: =back 2280: 2281: B<General security note>: You should ensure the user can not somehow 2282: pass something into your code that would allow them to look places 2283: they should not be able to see, like the C</etc/> directory. However, 2284: the security impact would be minimal, since it would only expose 2285: the existence of files, there should be no way to parlay that into 2286: viewing the files. 2287: 2288: =cut 2289: 2290: no strict; 2291: @ISA = ("Apache::lonhelper::element"); 2292: use strict; 2293: use Apache::lonlocal; 2294: 2295: use Apache::lonpubdir; # for getTitleString 2296: 2297: BEGIN { 2298: &Apache::lonhelper::register('Apache::lonhelper::files', 2299: ('files', 'filechoice', 'filefilter')); 2300: } 2301: 2302: sub not_old_version { 2303: my $file = shift; 2304: 2305: # Given a file name, return false if it is an "old version" of a 2306: # file, or true if it is not. 2307: 2308: if ($file =~ /^.*\.[0-9]+\.[A-Za-z]+(\.meta)?$/) { 2309: return 0; 2310: } 2311: return 1; 2312: } 2313: 2314: sub new { 2315: my $ref = Apache::lonhelper::element->new(); 2316: bless($ref); 2317: } 2318: 2319: sub start_files { 2320: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2321: 2322: if ($target ne 'helper') { 2323: return ''; 2324: } 2325: $paramHash->{'variable'} = $token->[2]{'variable'}; 2326: $helper->declareVar($paramHash->{'variable'}); 2327: $paramHash->{'multichoice'} = $token->[2]{'multichoice'}; 2328: } 2329: 2330: sub end_files { 2331: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2332: 2333: if ($target ne 'helper') { 2334: return ''; 2335: } 2336: if (!defined($paramHash->{FILTER_FUNC})) { 2337: $paramHash->{FILTER_FUNC} = sub { return 1; }; 2338: } 2339: Apache::lonhelper::files->new(); 2340: } 2341: 2342: sub start_filechoice { 2343: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2344: 2345: if ($target ne 'helper') { 2346: return ''; 2347: } 2348: $paramHash->{'filechoice'} = Apache::lonxml::get_all_text('/filechoice', 2349: $parser); 2350: } 2351: 2352: sub end_filechoice { return ''; } 2353: 2354: sub start_filefilter { 2355: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2356: 2357: if ($target ne 'helper') { 2358: return ''; 2359: } 2360: 2361: my $contents = Apache::lonxml::get_all_text('/filefilter', 2362: $parser); 2363: $contents = 'sub { my $filename = shift; ' . $contents . '}'; 2364: $paramHash->{FILTER_FUNC} = eval $contents; 2365: } 2366: 2367: sub end_filefilter { return ''; } 2368: 2369: sub render { 2370: my $self = shift; 2371: my $result = ''; 2372: my $var = $self->{'variable'}; 2373: 2374: my $subdirFunc = eval('sub {' . $self->{'filechoice'} . '}'); 2375: die 'Error in resource filter code for variable ' . 2376: {'variable'} . ', Perl said:' . $@ if $@; 2377: 2378: my $subdir = &$subdirFunc(); 2379: 2380: my $filterFunc = $self->{FILTER_FUNC}; 2381: if (!defined($filterFunc)) { 2382: $filterFunc = ¬_old_version; 2383: } 2384: my $buttons = ''; 2385: my $type = 'radio'; 2386: if ($self->{'multichoice'}) { 2387: $type = 'checkbox'; 2388: } 2389: 2390: if ($self->{'multichoice'}) { 2391: $result = <<SCRIPT; 2392: <script> 2393: function checkall(value, checkName) { 2394: for (i=0; i<document.forms.helpform.elements.length; i++) { 2395: ele = document.forms.helpform.elements[i]; 2396: if (ele.name == checkName + '.forminput') { 2397: document.forms.helpform.elements[i].checked=value; 2398: } 2399: } 2400: } 2401: 2402: function checkallclass(value, className) { 2403: for (i=0; i<document.forms.helpform.elements.length; i++) { 2404: ele = document.forms.helpform.elements[i]; 2405: if (ele.type == "$type" && ele.onclick) { 2406: document.forms.helpform.elements[i].checked=value; 2407: } 2408: } 2409: } 2410: </script> 2411: SCRIPT 2412: my %lt=&Apache::lonlocal::texthash( 2413: 'saf' => "Select All Files", 2414: 'uaf' => "Unselect All Files"); 2415: $buttons = <<BUTTONS; 2416: <br /> 2417: <input type="button" onclick="checkall(true, '$var')" value="$lt{'saf'}" /> 2418: <input type="button" onclick="checkall(false, '$var')" value="$lt{'uaf'}" /> 2419: BUTTONS 2420: 2421: %lt=&Apache::lonlocal::texthash( 2422: 'sap' => "Select All Published", 2423: 'uap' => "Unselect All Published"); 2424: if ($helper->{VARS}->{'construction'}) { 2425: $buttons .= <<BUTTONS; 2426: <input type="button" onclick="checkallclass(true, 'Published')" value="$lt{'sap'}" /> 2427: <input type="button" onclick="checkallclass(false, 'Published')" value="$lt{'uap'}" /> 2428: <br /> 2429: BUTTONS 2430: } 2431: } 2432: 2433: # Get the list of files in this directory. 2434: my @fileList; 2435: 2436: # If the subdirectory is in local CSTR space 2437: my $metadir; 2438: if ($subdir =~ m|/home/([^/]+)/public_html/(.*)|) { 2439: my $user = $1; 2440: my $domain = $Apache::lonnet::perlvar{'lonDefDomain'}; 2441: $metadir='/res/'.$domain.'/'.$user.'/'.$2; 2442: @fileList = &Apache::lonnet::dirlist($subdir, $domain, $user, ''); 2443: } elsif ($subdir =~ m|^~([^/]+)/(.*)$|) { 2444: $subdir='/home/'.$1.'/public_html/'.$2; 2445: my $user = $1; 2446: my $domain = $Apache::lonnet::perlvar{'lonDefDomain'}; 2447: $metadir='/res/'.$domain.'/'.$user.'/'.$2; 2448: @fileList = &Apache::lonnet::dirlist($subdir, $domain, $user, ''); 2449: } else { 2450: # local library server resource space 2451: @fileList = &Apache::lonnet::dirlist($subdir, $ENV{'user.domain'}, $ENV{'user.name'}, ''); 2452: } 2453: 2454: # Sort the fileList into order 2455: @fileList = sort @fileList; 2456: 2457: $result .= $buttons; 2458: 2459: if (defined $self->{ERROR_MSG}) { 2460: $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />'; 2461: } 2462: 2463: $result .= '<table border="0" cellpadding="2" cellspacing="0">'; 2464: 2465: # Keeps track if there are no choices, prints appropriate error 2466: # if there are none. 2467: my $choices = 0; 2468: # Print each legitimate file choice. 2469: for my $file (@fileList) { 2470: $file = (split(/&/, $file))[0]; 2471: if ($file eq '.' || $file eq '..') { 2472: next; 2473: } 2474: my $fileName = $subdir .'/'. $file; 2475: if (&$filterFunc($file)) { 2476: my $status; 2477: my $color; 2478: if ($helper->{VARS}->{'construction'}) { 2479: ($status, $color) = @{fileState($subdir, $file)}; 2480: } else { 2481: $status = ''; 2482: $color = ''; 2483: } 2484: 2485: # Get the title 2486: my $title = Apache::lonpubdir::getTitleString(($metadir?$metadir:$subdir) .'/'. $file); 2487: 2488: # Netscape 4 is stupid and there's nowhere to put the 2489: # information on the input tag that the file is Published, 2490: # Unpublished, etc. In *real* browsers we can just say 2491: # "class='Published'" and check the className attribute of 2492: # the input tag, but Netscape 4 is too stupid to understand 2493: # that attribute, and un-comprehended attributes are not 2494: # reflected into the object model. So instead, what I do 2495: # is either have or don't have an "onclick" handler that 2496: # does nothing, give Published files the onclick handler, and 2497: # have the checker scripts check for that. Stupid and clumsy, 2498: # and only gives us binary "yes/no" information (at least I 2499: # couldn't figure out how to reach into the event handler's 2500: # actual code to retreive a value), but it works well enough 2501: # here. 2502: 2503: my $onclick = ''; 2504: if ($status eq 'Published' && $helper->{VARS}->{'construction'}) { 2505: $onclick = 'onclick="a=1" '; 2506: } 2507: $result .= '<tr><td align="right"' . " bgcolor='$color'>" . 2508: "<input $onclick type='$type' name='" . $var 2509: . ".forminput' value='" . HTML::Entities::encode($fileName,'<>&"'). 2510: "'"; 2511: if (!$self->{'multichoice'} && $choices == 0) { 2512: $result .= ' checked'; 2513: } 2514: $result .= "/></td><td bgcolor='$color'>" . $file . "</td>" . 2515: "<td bgcolor='$color'>$title</td>" . 2516: "<td bgcolor='$color'>$status</td>" . "</tr>\n"; 2517: $choices++; 2518: } 2519: } 2520: 2521: $result .= "</table>\n"; 2522: 2523: if (!$choices) { 2524: $result .= '<font color="#FF0000">There are no files available to select in this directory ('.$subdir.'). Please go back and select another option.</font><br /><br />'; 2525: } 2526: 2527: $result .= $buttons; 2528: 2529: return $result; 2530: } 2531: 2532: # Determine the state of the file: Published, unpublished, modified. 2533: # Return the color it should be in and a label as a two-element array 2534: # reference. 2535: # Logic lifted from lonpubdir.pm, even though I don't know that it's still 2536: # the most right thing to do. 2537: 2538: sub fileState { 2539: my $constructionSpaceDir = shift; 2540: my $file = shift; 2541: 2542: my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'}; 2543: my $subdirpart = $constructionSpaceDir; 2544: $subdirpart =~ s/^\/home\/$ENV{'user.name'}\/public_html//; 2545: my $resdir = $docroot . '/res/' . $ENV{'user.domain'} . '/' . $ENV{'user.name'} . 2546: $subdirpart; 2547: 2548: my @constructionSpaceFileStat = stat($constructionSpaceDir . '/' . $file); 2549: my @resourceSpaceFileStat = stat($resdir . '/' . $file); 2550: if (!@resourceSpaceFileStat) { 2551: return ['Unpublished', '#FFCCCC']; 2552: } 2553: 2554: my $constructionSpaceFileModified = $constructionSpaceFileStat[9]; 2555: my $resourceSpaceFileModified = $resourceSpaceFileStat[9]; 2556: 2557: if ($constructionSpaceFileModified > $resourceSpaceFileModified) { 2558: return ['Modified', '#FFFFCC']; 2559: } 2560: return ['Published', '#CCFFCC']; 2561: } 2562: 2563: sub postprocess { 2564: my $self = shift; 2565: my $result = $ENV{'form.' . $self->{'variable'} . '.forminput'}; 2566: if (!$result) { 2567: $self->{ERROR_MSG} = 'You must choose at least one file '. 2568: 'to continue.'; 2569: return 0; 2570: } 2571: 2572: if (defined($self->{NEXTSTATE})) { 2573: $helper->changeState($self->{NEXTSTATE}); 2574: } 2575: 2576: return 1; 2577: } 2578: 2579: 1; 2580: 2581: package Apache::lonhelper::section; 2582: 2583: =pod 2584: 2585: =head2 Element: sectionX<section, helper element> 2586: 2587: <section> allows the user to choose one or more sections from the current 2588: course. 2589: 2590: It takes the standard attributes "variable", "multichoice", and 2591: "nextstate", meaning what they do for most other elements. 2592: 2593: =cut 2594: 2595: no strict; 2596: @ISA = ("Apache::lonhelper::choices"); 2597: use strict; 2598: 2599: BEGIN { 2600: &Apache::lonhelper::register('Apache::lonhelper::section', 2601: ('section')); 2602: } 2603: 2604: sub new { 2605: my $ref = Apache::lonhelper::choices->new(); 2606: bless($ref); 2607: } 2608: 2609: sub start_section { 2610: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2611: 2612: if ($target ne 'helper') { 2613: return ''; 2614: } 2615: 2616: $paramHash->{CHOICES} = []; 2617: 2618: $paramHash->{'variable'} = $token->[2]{'variable'}; 2619: $helper->declareVar($paramHash->{'variable'}); 2620: $paramHash->{'multichoice'} = $token->[2]{'multichoice'}; 2621: if (defined($token->[2]{'nextstate'})) { 2622: $paramHash->{NEXTSTATE} = $token->[2]{'nextstate'}; 2623: } 2624: 2625: # Populate the CHOICES element 2626: my %choices; 2627: 2628: my $section = Apache::loncoursedata::CL_SECTION(); 2629: my $classlist = Apache::loncoursedata::get_classlist(); 2630: foreach (keys %$classlist) { 2631: my $sectionName = $classlist->{$_}->[$section]; 2632: if (!$sectionName) { 2633: $choices{"No section assigned"} = ""; 2634: } else { 2635: $choices{$sectionName} = $sectionName; 2636: } 2637: } 2638: 2639: for my $sectionName (sort(keys(%choices))) { 2640: 2641: push @{$paramHash->{CHOICES}}, [$sectionName, $sectionName]; 2642: } 2643: } 2644: 2645: sub end_section { 2646: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2647: 2648: if ($target ne 'helper') { 2649: return ''; 2650: } 2651: Apache::lonhelper::section->new(); 2652: } 2653: 1; 2654: 2655: package Apache::lonhelper::string; 2656: 2657: =pod 2658: 2659: =head2 Element: stringX<string, helper element> 2660: 2661: string elements provide a string entry field for the user. string elements 2662: take the usual 'variable' and 'nextstate' parameters. string elements 2663: also pass through 'maxlength' and 'size' attributes to the input tag. 2664: 2665: string honors the defaultvalue tag, if given. 2666: 2667: string honors the validation function, if given. 2668: 2669: =cut 2670: 2671: no strict; 2672: @ISA = ("Apache::lonhelper::element"); 2673: use strict; 2674: use Apache::lonlocal; 2675: 2676: BEGIN { 2677: &Apache::lonhelper::register('Apache::lonhelper::string', 2678: ('string')); 2679: } 2680: 2681: sub new { 2682: my $ref = Apache::lonhelper::element->new(); 2683: bless($ref); 2684: } 2685: 2686: # CONSTRUCTION: Construct the message element from the XML 2687: sub start_string { 2688: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2689: 2690: if ($target ne 'helper') { 2691: return ''; 2692: } 2693: 2694: $paramHash->{'variable'} = $token->[2]{'variable'}; 2695: $helper->declareVar($paramHash->{'variable'}); 2696: $paramHash->{'nextstate'} = $token->[2]{'nextstate'}; 2697: $paramHash->{'maxlength'} = $token->[2]{'maxlength'}; 2698: $paramHash->{'size'} = $token->[2]{'size'}; 2699: 2700: return ''; 2701: } 2702: 2703: sub end_string { 2704: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2705: 2706: if ($target ne 'helper') { 2707: return ''; 2708: } 2709: Apache::lonhelper::string->new(); 2710: return ''; 2711: } 2712: 2713: sub render { 2714: my $self = shift; 2715: my $result = ''; 2716: 2717: if (defined $self->{ERROR_MSG}) { 2718: $result .= '<br /><font color="#FF0000">' . $self->{ERROR_MSG} . '</font><br /><br />'; 2719: } 2720: 2721: $result .= '<input type="string" name="' . $self->{'variable'} . '.forminput"'; 2722: 2723: if (defined($self->{'size'})) { 2724: $result .= ' size="' . $self->{'size'} . '"'; 2725: } 2726: if (defined($self->{'maxlength'})) { 2727: $result .= ' maxlength="' . $self->{'maxlength'} . '"'; 2728: } 2729: 2730: if (defined($self->{DEFAULT_VALUE})) { 2731: my $valueFunc = eval($self->{DEFAULT_VALUE}); 2732: die 'Error in default value code for variable ' . 2733: $self->{'variable'} . ', Perl said: ' . $@ if $@; 2734: $result .= ' value="' . &$valueFunc($helper, $self) . '"'; 2735: } 2736: 2737: $result .= ' />'; 2738: 2739: return $result; 2740: } 2741: 2742: # If a NEXTSTATE was given, switch to it 2743: sub postprocess { 2744: my $self = shift; 2745: 2746: if (defined($self->{VALIDATOR})) { 2747: my $validator = eval($self->{VALIDATOR}); 2748: die 'Died during evaluation of evaulation code; Perl said: ' . $@ if $@; 2749: my $invalid = &$validator($helper, $state, $self, $self->getValue()); 2750: if ($invalid) { 2751: $self->{ERROR_MSG} = $invalid; 2752: return 0; 2753: } 2754: } 2755: 2756: if (defined($self->{'nextstate'})) { 2757: $helper->changeState($self->{'nextstate'}); 2758: } 2759: 2760: return 1; 2761: } 2762: 2763: 1; 2764: 2765: package Apache::lonhelper::general; 2766: 2767: =pod 2768: 2769: =head2 General-purpose tag: <exec>X<exec, helper tag> 2770: 2771: The contents of the exec tag are executed as Perl code, B<not> inside a 2772: safe space, so the full range of $ENV and such is available. The code 2773: will be executed as a subroutine wrapped with the following code: 2774: 2775: "sub { my $helper = shift; my $state = shift;" and 2776: 2777: "}" 2778: 2779: The return value is ignored. 2780: 2781: $helper is the helper object. Feel free to add methods to the helper 2782: object to support whatever manipulation you may need to do (for instance, 2783: overriding the form location if the state is the final state; see 2784: parameter.helper for an example). 2785: 2786: $state is the $paramHash that has currently been generated and may 2787: be manipulated by the code in exec. Note that the $state is not yet 2788: an actual state B<object>, it is just a hash, so do not expect to 2789: be able to call methods on it. 2790: 2791: =cut 2792: 2793: BEGIN { 2794: &Apache::lonhelper::register('Apache::lonhelper::general', 2795: 'exec', 'condition', 'clause', 2796: 'eval'); 2797: } 2798: 2799: sub start_exec { 2800: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2801: 2802: if ($target ne 'helper') { 2803: return ''; 2804: } 2805: 2806: my $code = &Apache::lonxml::get_all_text('/exec', $parser); 2807: 2808: $code = eval ('sub { my $helper = shift; my $state = shift; ' . 2809: $code . "}"); 2810: die 'Error in <exec>, Perl said: '. $@ if $@; 2811: &$code($helper, $paramHash); 2812: } 2813: 2814: sub end_exec { return ''; } 2815: 2816: =pod 2817: 2818: =head2 General-purpose tag: <condition> 2819: 2820: The <condition> tag allows you to mask out parts of the helper code 2821: depending on some programatically determined condition. The condition 2822: tag contains a tag <clause> which contains perl code that when wrapped 2823: with "sub { my $helper = shift; my $state = shift; " and "}", returns 2824: a true value if the XML in the condition should be evaluated as a normal 2825: part of the helper, or false if it should be completely discarded. 2826: 2827: The <clause> tag must be the first sub-tag of the <condition> tag or 2828: it will not work as expected. 2829: 2830: =cut 2831: 2832: # The condition tag just functions as a marker, it doesn't have 2833: # to "do" anything. Technically it doesn't even have to be registered 2834: # with the lonxml code, but I leave this here to be explicit about it. 2835: sub start_condition { return ''; } 2836: sub end_condition { return ''; } 2837: 2838: sub start_clause { 2839: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2840: 2841: if ($target ne 'helper') { 2842: return ''; 2843: } 2844: 2845: my $clause = Apache::lonxml::get_all_text('/clause', $parser); 2846: $clause = eval('sub { my $helper = shift; my $state = shift; ' 2847: . $clause . '}'); 2848: die 'Error in clause of condition, Perl said: ' . $@ if $@; 2849: if (!&$clause($helper, $paramHash)) { 2850: # Discard all text until the /condition. 2851: &Apache::lonxml::get_all_text('/condition', $parser); 2852: } 2853: } 2854: 2855: sub end_clause { return ''; } 2856: 2857: =pod 2858: 2859: =head2 General-purpose tag: <eval>X<eval, helper tag> 2860: 2861: The <eval> tag will be evaluated as a subroutine call passed in the 2862: current helper object and state hash as described in <condition> above, 2863: but is expected to return a string to be printed directly to the 2864: screen. This is useful for dynamically generating messages. 2865: 2866: =cut 2867: 2868: # This is basically a type of message. 2869: # Programmatically setting $paramHash->{NEXTSTATE} would work, though 2870: # it's probably bad form. 2871: 2872: sub start_eval { 2873: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2874: 2875: if ($target ne 'helper') { 2876: return ''; 2877: } 2878: 2879: my $program = Apache::lonxml::get_all_text('/eval', $parser); 2880: $program = eval('sub { my $helper = shift; my $state = shift; ' 2881: . $program . '}'); 2882: die 'Error in eval code, Perl said: ' . $@ if $@; 2883: $paramHash->{MESSAGE_TEXT} = &$program($helper, $paramHash); 2884: } 2885: 2886: sub end_eval { 2887: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2888: 2889: if ($target ne 'helper') { 2890: return ''; 2891: } 2892: 2893: Apache::lonhelper::message->new(); 2894: } 2895: 2896: 1; 2897: 2898: package Apache::lonhelper::final; 2899: 2900: =pod 2901: 2902: =head2 Element: finalX<final, helper tag> 2903: 2904: <final> is a special element that works with helpers that use the <finalcode> 2905: tagX<finalcode, helper tag>. It goes through all the states and elements, executing the <finalcode> 2906: snippets and collecting the results. Finally, it takes the user out of the 2907: helper, going to a provided page. 2908: 2909: If the parameter "restartCourse" is true, this will override the buttons and 2910: will make a "Finish Helper" button that will re-initialize the course for them, 2911: which is useful for the Course Initialization helper so the users never see 2912: the old values taking effect. 2913: 2914: =cut 2915: 2916: no strict; 2917: @ISA = ("Apache::lonhelper::element"); 2918: use strict; 2919: use Apache::lonlocal; 2920: BEGIN { 2921: &Apache::lonhelper::register('Apache::lonhelper::final', 2922: ('final', 'exitpage')); 2923: } 2924: 2925: sub new { 2926: my $ref = Apache::lonhelper::element->new(); 2927: bless($ref); 2928: } 2929: 2930: sub start_final { 2931: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2932: 2933: if ($target ne 'helper') { 2934: return ''; 2935: } 2936: 2937: $paramHash->{'restartCourse'} = $token->[2]{'restartCourse'}; 2938: 2939: return ''; 2940: } 2941: 2942: sub end_final { 2943: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2944: 2945: if ($target ne 'helper') { 2946: return ''; 2947: } 2948: 2949: Apache::lonhelper::final->new(); 2950: 2951: return ''; 2952: } 2953: 2954: sub start_exitpage { 2955: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 2956: 2957: if ($target ne 'helper') { 2958: return ''; 2959: } 2960: 2961: $paramHash->{EXIT_PAGE} = &Apache::lonxml::get_all_text('/exitpage', 2962: $parser); 2963: 2964: return ''; 2965: } 2966: 2967: sub end_exitpage { return ''; } 2968: 2969: sub render { 2970: my $self = shift; 2971: 2972: my @results; 2973: 2974: # Collect all the results 2975: for my $stateName (keys %{$helper->{STATES}}) { 2976: my $state = $helper->{STATES}->{$stateName}; 2977: 2978: for my $element (@{$state->{ELEMENTS}}) { 2979: if (defined($element->{FINAL_CODE})) { 2980: # Compile the code. 2981: my $code = 'sub { my $helper = shift; my $element = shift; ' 2982: . $element->{FINAL_CODE} . '}'; 2983: $code = eval($code); 2984: die 'Error while executing final code for element with var ' . 2985: $element->{'variable'} . ', Perl said: ' . $@ if $@; 2986: 2987: my $result = &$code($helper, $element); 2988: if ($result) { 2989: push @results, $result; 2990: } 2991: } 2992: } 2993: } 2994: 2995: my $result; 2996: 2997: if (scalar(@results) != 0) { 2998: $result .= "<ul>\n"; 2999: for my $re (@results) { 3000: $result .= ' <li>' . $re . "</li>\n"; 3001: } 3002: 3003: if (!@results) { 3004: $result .= ' <li>' . 3005: &mt('No changes were made to current settings.') . '</li>'; 3006: } 3007: 3008: $result .= '</ul>'; 3009: } 3010: 3011: if ($self->{'restartCourse'}) { 3012: my $targetURL = '/adm/menu'; 3013: if ($ENV{'course.'.$ENV{'request.course.id'}.'.url'}=~/^uploaded/) { 3014: $targetURL = '/adm/coursedocs'; 3015: } else { 3016: $targetURL = '/adm/navmaps'; 3017: } 3018: if ($ENV{'course.'.$ENV{'request.course.id'}.'.clonedfrom'}) { 3019: $targetURL = '/adm/parmset?overview=1'; 3020: } 3021: my $previous = HTML::Entities::encode(&mt("<- Previous"), '<>&"'); 3022: my $next = HTML::Entities::encode(&mt("Next ->"), '<>&"'); 3023: $result .= "<center>\n" . 3024: "<form action='/adm/roles' method='post' target='loncapaclient'>\n" . 3025: "<input type='button' onclick='history.go(-1)' value='$previous' />" . 3026: "<input type='hidden' name='orgurl' value='$targetURL' />" . 3027: "<input type='hidden' name='selectrole' value='1' />\n" . 3028: "<input type='hidden' name='" . $ENV{'request.role'} . 3029: "' value='1' />\n<input type='submit' value='" . 3030: &mt('Finish Course Initialization') . "' />\n" . 3031: "</form></center>"; 3032: } 3033: 3034: return $result; 3035: } 3036: 3037: sub overrideForm { 3038: my $self = shift; 3039: return $self->{'restartCourse'}; 3040: } 3041: 3042: 1; 3043: 3044: package Apache::lonhelper::parmwizfinal; 3045: 3046: # This is the final state for the parmwizard. It is not generally useful, 3047: # so it is not perldoc'ed. It does its own processing. 3048: # It is represented with <parmwizfinal />, and 3049: # should later be moved to lonparmset.pm . 3050: 3051: no strict; 3052: @ISA = ('Apache::lonhelper::element'); 3053: use strict; 3054: use Apache::lonlocal; 3055: 3056: BEGIN { 3057: &Apache::lonhelper::register('Apache::lonhelper::parmwizfinal', 3058: ('parmwizfinal')); 3059: } 3060: 3061: use Time::localtime; 3062: 3063: sub new { 3064: my $ref = Apache::lonhelper::choices->new(); 3065: bless ($ref); 3066: } 3067: 3068: sub start_parmwizfinal { return ''; } 3069: 3070: sub end_parmwizfinal { 3071: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 3072: 3073: if ($target ne 'helper') { 3074: return ''; 3075: } 3076: Apache::lonhelper::parmwizfinal->new(); 3077: } 3078: 3079: # Renders a form that, when submitted, will form the input to lonparmset.pm 3080: sub render { 3081: my $self = shift; 3082: my $vars = $helper->{VARS}; 3083: 3084: # FIXME: Unify my designators with the standard ones 3085: my %dateTypeHash = ('open_date' => "opening date", 3086: 'due_date' => "due date", 3087: 'answer_date' => "answer date", 3088: 'tries' => 'number of tries', 3089: 'weight' => 'problem weight' 3090: ); 3091: my %parmTypeHash = ('open_date' => "0_opendate", 3092: 'due_date' => "0_duedate", 3093: 'answer_date' => "0_answerdate", 3094: 'tries' => '0_maxtries', 3095: 'weight' => '0_weight' ); 3096: 3097: my $affectedResourceId = ""; 3098: my $parm_name = $parmTypeHash{$vars->{ACTION_TYPE}}; 3099: my $level = ""; 3100: my $resourceString; 3101: my $symb; 3102: my $paramlevel; 3103: 3104: # Print the granularity, depending on the action 3105: if ($vars->{GRANULARITY} eq 'whole_course') { 3106: $resourceString .= '<li>'.&mt('for <b>all resources in the course</b>').'</li>'; 3107: $level = 9; # general course, see lonparmset.pm perldoc 3108: $affectedResourceId = "0.0"; 3109: $symb = 'a'; 3110: $paramlevel = 'general'; 3111: } elsif ($vars->{GRANULARITY} eq 'map') { 3112: my $navmap = Apache::lonnavmaps::navmap->new(); 3113: my $res = $navmap->getByMapPc($vars->{RESOURCE_ID}); 3114: my $title = $res->compTitle(); 3115: $symb = $res->symb(); 3116: $navmap->untieHashes(); 3117: $resourceString .= '<li>'.&mt('for the map named [_1]',"<b>$title</b>").'</li>'; 3118: $level = 8; 3119: $affectedResourceId = $vars->{RESOURCE_ID}; 3120: $paramlevel = 'map'; 3121: } else { 3122: my $navmap = Apache::lonnavmaps::navmap->new(); 3123: my $res = $navmap->getById($vars->{RESOURCE_ID}); 3124: $symb = $res->symb(); 3125: my $title = $res->compTitle(); 3126: $navmap->untieHashes(); 3127: $resourceString .= '<li>'.&mt('for the resource named [_1]',"<b>$title</b>").'</li>'; 3128: $level = 7; 3129: $affectedResourceId = $vars->{RESOURCE_ID}; 3130: $paramlevel = 'full'; 3131: } 3132: 3133: my $result = "<form name='helpform' method='get' action='/adm/parmset#$affectedResourceId&$parm_name&$level'>\n"; 3134: $result .= '<p>'.&mt('Confirm that this information is correct, then click "Finish Helper" to complete setting the parameter.').'<ul>'; 3135: 3136: # Print the type of manipulation: 3137: my $extra; 3138: if ($vars->{ACTION_TYPE} eq 'tries') { 3139: $extra = $vars->{TRIES}; 3140: } 3141: if ($vars->{ACTION_TYPE} eq 'weight') { 3142: $extra = $vars->{WEIGHT}; 3143: } 3144: $result .= "<li>"; 3145: my $what = &mt($dateTypeHash{$vars->{ACTION_TYPE}}); 3146: if ($extra) { 3147: $result .= &mt('Setting the [_1] to [_2]',"<b>$what</b>",$extra); 3148: } else { 3149: $result .= &mt('Setting the [_1]',"<b>$what</b>"); 3150: } 3151: $result .= "</li>\n"; 3152: if ($vars->{ACTION_TYPE} eq 'due_date' || 3153: $vars->{ACTION_TYPE} eq 'answer_date') { 3154: # for due dates, we default to "date end" type entries 3155: $result .= "<input type='hidden' name='recent_date_end' " . 3156: "value='" . $vars->{PARM_DATE} . "' />\n"; 3157: $result .= "<input type='hidden' name='pres_value' " . 3158: "value='" . $vars->{PARM_DATE} . "' />\n"; 3159: $result .= "<input type='hidden' name='pres_type' " . 3160: "value='date_end' />\n"; 3161: } elsif ($vars->{ACTION_TYPE} eq 'open_date') { 3162: $result .= "<input type='hidden' name='recent_date_start' ". 3163: "value='" . $vars->{PARM_DATE} . "' />\n"; 3164: $result .= "<input type='hidden' name='pres_value' " . 3165: "value='" . $vars->{PARM_DATE} . "' />\n"; 3166: $result .= "<input type='hidden' name='pres_type' " . 3167: "value='date_start' />\n"; 3168: } elsif ($vars->{ACTION_TYPE} eq 'tries') { 3169: $result .= "<input type='hidden' name='pres_value' " . 3170: "value='" . $vars->{TRIES} . "' />\n"; 3171: } elsif ($vars->{ACTION_TYPE} eq 'weight') { 3172: $result .= "<input type='hidden' name='pres_value' " . 3173: "value='" . $vars->{WEIGHT} . "' />\n"; 3174: } 3175: 3176: $result .= $resourceString; 3177: 3178: # Print targets 3179: if ($vars->{TARGETS} eq 'course') { 3180: $result .= '<li>'.&mt('for <b>all students in course</b>').'</li>'; 3181: } elsif ($vars->{TARGETS} eq 'section') { 3182: my $section = $vars->{SECTION_NAME}; 3183: $result .= &mt('<li>for section <b>[_1]</b></li>',$section); 3184: $level -= 3; 3185: $result .= "<input type='hidden' name='csec' value='" . 3186: HTML::Entities::encode($section,'<>&"') . "' />\n"; 3187: } else { 3188: # FIXME: This is probably wasteful! Store the name! 3189: my $classlist = Apache::loncoursedata::get_classlist(); 3190: my $username = $vars->{USER_NAME}; 3191: # Chop off everything after the last colon (section) 3192: $username = substr($username, 0, rindex($username, ':')); 3193: my $name = $classlist->{$username}->[6]; 3194: $result .= &mt('<li>for <b>[_1]</b></li>',$name); 3195: ## $result .= "<li>".&mt('for [_1]',"<b>$name</b>")."</li>"; 3196: $level -= 6; 3197: my ($uname, $udom) = split /:/, $vars->{USER_NAME}; 3198: $result .= "<input type='hidden' name='uname' value='". 3199: HTML::Entities::encode($uname,'<>&"') . "' />\n"; 3200: $result .= "<input type='hidden' name='udom' value='". 3201: HTML::Entities::encode($udom,'<>&"') . "' />\n"; 3202: } 3203: 3204: # Print value 3205: if ($vars->{ACTION_TYPE} ne 'tries' && $vars->{ACTION_TYPE} ne 'weight') { 3206: $result .= "<li>".&mt('to')." <b>" . ctime($vars->{PARM_DATE}) . "</b> (" . 3207: Apache::lonnavmaps::timeToHumanString($vars->{PARM_DATE}) 3208: . ")</li>\n"; 3209: } 3210: 3211: # print pres_marker 3212: $result .= "\n<input type='hidden' name='pres_marker'" . 3213: " value='$affectedResourceId&$parm_name&$level' />\n"; 3214: 3215: # Make the table appear 3216: $result .= "\n<input type='hidden' value='true' name='prevvisit' />"; 3217: $result .= "\n<input type='hidden' value='all' name='pschp' />"; 3218: $result .= "\n<input type='hidden' value='$symb' name='pssymb' />"; 3219: $result .= "\n<input type='hidden' value='$paramlevel' name='parmlev' />"; 3220: 3221: $result .= "<br /><br /><center><input type='submit' value='".&mt('Finish Helper')."' /></center></form>\n"; 3222: 3223: return $result; 3224: } 3225: 3226: sub overrideForm { 3227: return 1; 3228: } 3229: 3230: 1; 3231: 3232: __END__ 3233: