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