--- loncom/interface/loncommon.pm 2008/03/03 10:50:26 1.643 +++ loncom/interface/loncommon.pm 2008/03/28 14:52:52 1.650 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.643 2008/03/03 10:50:26 foxr Exp $ +# $Id: loncommon.pm,v 1.650 2008/03/28 14:52:52 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -84,25 +84,40 @@ my $readit; =pod -=head1 Server Side incliude with retries: +=head1 Server Side include with retries: =over 4 -=item * ssi_with_retries(resource, retries form) +=item * &ssi_with_retries(resource,retries form) Performs an ssi with some number of retries. Retries continue either until the result is ok or until the retry count supplied by the caller is exhausted. Inputs: + +=over 4 + resource - Identifies the resource to insert. + retries - Count of the number of retries allowed. + form - Hash that identifies the rendering options. -Returns: +=back + +Returns: + +=over 4 + content - The content of the response. If retries were exhausted this is empty. + response - The response from the last attempt (which may or may not have been successful. +=back + +=back + =cut sub ssi_with_retries { @@ -118,6 +133,9 @@ sub ssi_with_retries { do { ($content, $response) = &Apache::lonnet::ssi($resource, %form); $ok = $response->is_success; + if (!$ok) { + &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message); + } $retries--; } while (!$ok && ($retries > 0)); @@ -266,14 +284,14 @@ BEGIN { =over 4 -=item * browser_and_searcher_javascript () +=item * &browser_and_searcher_javascript() XXReturns a string containing javascript with two functions, C and C. Returned string does not contain EscriptE tags. -=item * openbrowser(formname,elementname,only,omit) [javascript] +=item * &openbrowser(formname,elementname,only,omit) [javascript] inputs: formname, elementname, only, omit @@ -286,7 +304,7 @@ with the given extension. Can be a comm Specifying 'omit' will restrict the browser to NOT displaying files with the given extension. Can be a comma separated list. -=item * opensearcher(formname, elementname) [javascript] +=item * &opensearcher(formname,elementname) [javascript] Inputs: formname, elementname @@ -371,7 +389,7 @@ sub storeresurl { unless ($resurl=~/^\/res/) { return 0; } $resurl=~s/\/$//; &Apache::lonnet::put('environment',{'lastresurl' => $resurl}); - &Apache::lonnet::appenv('environment.lastresurl' => $resurl); + &Apache::lonnet::appenv({'environment.lastresurl' => $resurl}); return 1; } @@ -594,7 +612,7 @@ ENDSCRT =pod -=item * linked_select_forms(...) +=item * &linked_select_forms(...) linked_select_forms returns a string containing a block and html for two element int multiple mode @@ -1531,7 +1548,7 @@ sub multiple_select_form { =pod -=item * select_form($defdom,$name,%hash) +=item * &select_form($defdom,$name,%hash) Returns a string containing a form to allow a user to select the domain to preform an operation in. @@ -1658,7 +1675,7 @@ sub select_dom_form { =pod -=item * home_server_form_item($domain,$name,$defaultflag) +=item * &home_server_form_item($domain,$name,$defaultflag) input: 4 arguments (two required, two optional) - $domain - domain of new user @@ -1818,14 +1835,12 @@ sub decode_user_agent { =over 4 -=item * authform_xxxxxx +=item * &authform_xxxxxx() The authform_xxxxxx subroutines provide javascript and html forms which handle some of the conveniences required for authentication forms. This is not an optimal method, but it works. -See loncreateuser.pm for invocation and use examples. - =over 4 =item * authform_header @@ -1842,7 +1857,7 @@ See loncreateuser.pm for invocation and =back -=back +See loncreateuser.pm for invocation and use examples. =cut @@ -2305,14 +2320,20 @@ sub get_assignable_auth { =pod -=item * get_kerberos_defaults +=item * &get_kerberos_defaults() get_kerberos_defaults($target_domain) returns the default kerberos version and domain. If not found, it defaults to version 4 and the domain of the server. +=over 4 + ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain); +=back + +=back + =cut #------------------------------------------- @@ -2332,11 +2353,6 @@ sub get_kerberos_defaults { return ($krbdef,$krbdefdom); } -=pod - -=back - -=cut ############################################################### ## Thesaurus Functions ## @@ -2348,7 +2364,7 @@ sub get_kerberos_defaults { =over 4 -=item * initialize_keywords +=item * &initialize_keywords() Initializes the package variable %Keywords if it is empty. Uses the package variable $thesaurus_db_file. @@ -2393,7 +2409,7 @@ sub initialize_keywords { =pod -=item * keyword($word) +=item * &keyword($word) Returns true if $word is a keyword. A keyword is a word that appears more than the average number of times in the thesaurus database. Calls @@ -2414,7 +2430,7 @@ sub keyword { =pod -=item * get_related_words +=item * &get_related_words() Look up a word in the thesaurus. Takes a scalar argument and returns an array of words. If the keyword is not in the thesaurus, an empty array @@ -2472,7 +2488,7 @@ sub get_related_words { =over 4 -=item * plainname($uname,$udom,$first) +=item * &plainname($uname,$udom,$first) Takes a users logon name and returns it as a string in "first middle last generation" form @@ -2501,7 +2517,7 @@ sub plainname { # -------------------------------------------------------------------- Nickname =pod -=item * nickname($uname,$udom) +=item * &nickname($uname,$udom) Gets a users name and returns it as a string as @@ -2551,18 +2567,21 @@ sub getnames { } # -------------------------------------------------------------------- getemails + =pod -=item * getemails($uname,$udom) +=item * &getemails($uname,$udom) Gets a user's email information and returns it as a hash with keys: notification, critnotification, permanentemail For notification and critnotification, values are comma-separated lists -of e-mail address(es); for permanentemail, value is a single e-mail address. +of e-mail addresses; for permanentemail, value is a single e-mail address. + =cut + sub getemails { my ($uname,$udom)=@_; if ($udom eq 'public' && $uname eq 'public') { @@ -2597,7 +2616,7 @@ sub flush_email_cache { =pod -=item * screenname($uname,$udom) +=item * &screenname($uname,$udom) Gets a users screenname and returns it as a string @@ -2693,7 +2712,7 @@ sub student_image_tag { =over 4 -=item * languageids() +=item * &languageids() returns list of all language ids @@ -2705,7 +2724,7 @@ sub languageids { =pod -=item * languagedescription() +=item * &languagedescription() returns description of a specified language id @@ -2730,7 +2749,7 @@ sub supportedlanguagecode { =pod -=item * copyrightids() +=item * ©rightids() returns list of all copyrights @@ -2742,7 +2761,7 @@ sub copyrightids { =pod -=item * copyrightdescription() +=item * ©rightdescription() returns description of a specified copyright id @@ -2754,7 +2773,7 @@ sub copyrightdescription { =pod -=item * source_copyrightids() +=item * &source_copyrightids() returns list of all source copyrights @@ -2766,7 +2785,7 @@ sub source_copyrightids { =pod -=item * source_copyrightdescription() +=item * &source_copyrightdescription() returns description of a specified source copyright id @@ -2778,7 +2797,7 @@ sub source_copyrightdescription { =pod -=item * filecategories() +=item * &filecategories() returns list of all file categories @@ -2790,7 +2809,7 @@ sub filecategories { =pod -=item * filecategorytypes() +=item * &filecategorytypes() returns list of file types belonging to a given file category @@ -2804,7 +2823,7 @@ sub filecategorytypes { =pod -=item * fileembstyle() +=item * &fileembstyle() returns embedding style for a specified file type @@ -2828,7 +2847,7 @@ sub filecategoryselect { =pod -=item * filedescription() +=item * &filedescription() returns description for a specified file type @@ -2842,7 +2861,7 @@ sub filedescription { =pod -=item * filedescriptionex() +=item * &filedescriptionex() returns description for a specified file type with extra formatting @@ -2960,7 +2979,7 @@ sub languages { =over 4 -=item * get_previous_attempt($symb, $username, $domain, $course, +=item * &get_previous_attempt($symb, $username, $domain, $course, $getattempt, $regexp, $gradesub) Return string with previous attempt on problem. Arguments: @@ -3104,7 +3123,7 @@ sub relative_to_absolute { =pod -=item * get_student_view +=item * &get_student_view() show a snapshot of what student was looking at @@ -3123,7 +3142,7 @@ sub get_student_view { } if (defined($target)) { $form{'grade_target'} = $target; } $feedurl=&Apache::lonnet::clutter($feedurl); - my $userview=&Apache::lonnet::ssi_body($feedurl,%form); + my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form); $userview=~s/\]*\>//gi; $userview=~s/\<\/body\>//gi; $userview=~s/\//gi; @@ -3132,12 +3151,40 @@ sub get_student_view { $userview=~s/\<\/head\>//gi; $userview=~s/action\s*\=/would_be_action\=/gi; $userview=&relative_to_absolute($feedurl,$userview); - return $userview; + if (wantarray) { + return ($userview,$response); + } else { + return $userview; + } +} + +sub get_student_view_with_retries { + my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_; + + my $ok = 0; # True if we got a good response. + my $content; + my $response; + + # Try to get the student_view done. within the retries count: + + do { + ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv); + $ok = $response->is_success; + if (!$ok) { + &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message); + } + $retries--; + } while (!$ok && ($retries > 0)); + + if (!$ok) { + $content = ''; # On error return an empty content. + } + return ($content, $response); } =pod -=item * get_student_answers() +=item * &get_student_answers() show a snapshot of how student was answering problem @@ -3994,7 +4041,7 @@ ENDROLE $dc_info = '('.$dc_info.')'; } - if ($env{'environment.remote'} eq 'off') { + if (($env{'environment.remote'} eq 'off') || ($args->{'suppress_header_logos'})) { # No Remote if ($env{'request.state'} eq 'construct') { $forcereg=1; @@ -4790,6 +4837,14 @@ table.LC_pick_box td.LC_pick_box_title { width: 184px; padding: 8px; } +table.LC_pick_box td.LC_selfenroll_pick_box_title { + background: $tabbg; + font-weight: bold; + text-align: right; + width: 350px; + padding: 8px; +} + table.LC_pick_box td.LC_pick_box_value { text-align: left; padding: 8px; @@ -5334,10 +5389,7 @@ Inputs: none sub font_settings { my $headerstring=''; - if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) { - $headerstring.= - ''; - } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) { + if (!$env{'browser.mathml'} && $env{'browser.unicode'}) { $headerstring.= ''; } @@ -5396,8 +5448,15 @@ sub endheadtag { Returns a uniform complete .. section for LON-CAPA web pages. -Inputs: $title - optional title for the page - $head_extra - optional extra HTML to put inside the +Inputs: + +=over 4 + +$title - optional title for the page + +$head_extra - optional extra HTML to put inside the + +=back =cut @@ -5412,44 +5471,54 @@ sub head { Returns a complete .. section for LON-CAPA web pages. -Inputs: $title - optional title for the page - $head_extra - optional extra HTML to incude inside the - $args - additional optional args supported are: - only_body -> is true will set &bodytag() onlybodytag +Inputs: + +=over 4 + +$title - optional title for the page + +$head_extra - optional extra HTML to incude inside the + +$args - additional optional args supported are: + +=over 8 + + only_body -> is true will set &bodytag() onlybodytag arg on - no_nav_bar -> is true will set &bodytag() notopbar arg on - add_entries -> additional attributes to add to the - domain -> force to color decorate a page for a + no_nav_bar -> is true will set &bodytag() notopbar arg on + add_entries -> additional attributes to add to the + domain -> force to color decorate a page for a specific domain - function -> force usage of a specific rolish color + function -> force usage of a specific rolish color scheme - redirect -> see &headtag() - bgcolor -> override the default page bg color - js_ready -> return a string ready for being used in + redirect -> see &headtag() + bgcolor -> override the default page bg color + js_ready -> return a string ready for being used in a javascript writeln - html_encode -> return a string ready for being used in + html_encode -> return a string ready for being used in a html attribute - force_register -> if is true will turn on the &bodytag() + force_register -> if is true will turn on the &bodytag() $forcereg arg - body_title -> alternate text to use instead of $title + body_title -> alternate text to use instead of $title in the title box that appears, this text is not auto translated like the $title is - frameset -> if true will start with a + frameset -> if true will start with a rather than - no_title -> if true the title bar won't be shown - skip_phases -> hash ref of + no_title -> if true the title bar won't be shown + skip_phases -> hash ref of head -> skip the generation body -> skip all generation - - no_inline_link -> if true and in remote mode, don't show the + no_inline_link -> if true and in remote mode, don't show the 'Switch To Inline Menu' link - - no_auto_mt_title -> prevent &mt()ing the title arg - - inherit_jsmath -> when creating popup window in a page, + no_auto_mt_title -> prevent &mt()ing the title arg + inherit_jsmath -> when creating popup window in a page, should it have jsmath forced on by the current page +=back + +=back + =cut sub start_page { @@ -6730,6 +6799,47 @@ sub sorted_inst_types { return ($othertitle,$usertypes,\@types); } +sub get_institutional_codes { + my ($settings,$allcourses,$LC_code) = @_; +# Get complete list of course sections to update + my @currsections = (); + my @currxlists = (); + my $coursecode = $$settings{'internal.coursecode'}; + + if ($$settings{'internal.sectionnums'} ne '') { + @currsections = split(/,/,$$settings{'internal.sectionnums'}); + } + + if ($$settings{'internal.crosslistings'} ne '') { + @currxlists = split(/,/,$$settings{'internal.crosslistings'}); + } + + if (@currxlists > 0) { + foreach (@currxlists) { + if (m/^([^:]+):(\w*)$/) { + unless (grep/^$1$/,@{$allcourses}) { + push @{$allcourses},$1; + $$LC_code{$1} = $2; + } + } + } + } + + if (@currsections > 0) { + foreach (@currsections) { + if (m/^(\w+):(\w*)$/) { + my $sec = $coursecode.$1; + my $lc_sec = $2; + unless (grep/^$sec$/,@{$allcourses}) { + push @{$allcourses},$sec; + $$LC_code{$sec} = $lc_sec; + } + } + } + } + return; +} + =pod =back @@ -6738,7 +6848,7 @@ sub sorted_inst_types { =over 4 -=item * get_unprocessed_cgi($query,$possible_names) +=item * &get_unprocessed_cgi($query,$possible_names) Modify the %env hash to contain unprocessed CGI form parameters held in $query. The parameters listed in $possible_names (an array reference), @@ -6767,7 +6877,7 @@ sub get_unprocessed_cgi { =pod -=item * cacheheader() +=item * &cacheheader() returns cache-controlling header code @@ -6784,7 +6894,7 @@ sub cacheheader { =pod -=item * no_cache($r) +=item * &no_cache($r) specifies header code to not have cache @@ -6820,7 +6930,7 @@ sub content_type { =pod -=item * add_to_env($name,$value) +=item * &add_to_env($name,$value) adds $name to the %env hash with value $value, if $name already exists, the entry is converted to an array @@ -6847,7 +6957,7 @@ sub add_to_env { =pod -=item * get_env_multiple($name) +=item * &get_env_multiple($name) gets $name from the %env hash, it seemlessly handles the cases where multiple values may be defined and end up as an array ref. @@ -6879,7 +6989,7 @@ sub get_env_multiple { =over 4 -=item * upfile_store($r) +=item * &upfile_store($r) Store uploaded file, $r should be the HTTP Request object, needs $env{'form.upfile'} @@ -6909,7 +7019,7 @@ sub upfile_store { =pod -=item * load_tmp_file($r) +=item * &load_tmp_file($r) Load uploaded file from tmp, $r should be the HTTP Request object, needs $env{'form.datatoken'}, @@ -6933,7 +7043,7 @@ sub load_tmp_file { =pod -=item * upfile_record_sep() +=item * &upfile_record_sep() Separate uploaded file into records returns array of records, @@ -6955,7 +7065,7 @@ sub upfile_record_sep { =pod -=item * record_sep($record) +=item * &record_sep($record) Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'} @@ -7040,7 +7150,7 @@ sub record_sep { =pod -=item * upfile_select_html() +=item * &upfile_select_html() Return HTML code to select a file from the users machine and specify the file type. @@ -7087,7 +7197,7 @@ sub get_samples { =pod -=item * csv_print_samples($r,$records) +=item * &csv_print_samples($r,$records) Prints a table of sample values from each column uploaded $r is an Apache Request ref, $records is an arrayref from @@ -7123,7 +7233,7 @@ sub csv_print_samples { =pod -=item * csv_print_select_table($r,$records,$d) +=item * &csv_print_select_table($r,$records,$d) Prints a table to create associations between values and table columns. @@ -7169,7 +7279,7 @@ sub csv_print_select_table { =pod -=item * csv_samples_select_table($r,$records,$d) +=item * &csv_samples_select_table($r,$records,$d) Prints a table of sample values from the upload and can make associate samples to internal names. @@ -7219,7 +7329,7 @@ sub csv_samples_select_table { =pod -=item clean_excel_name($name) +=item * &clean_excel_name($name) Returns a replacement for $name which does not contain any illegal characters. @@ -7238,7 +7348,7 @@ sub clean_excel_name { =pod -=item * check_if_partid_hidden($id,$symb,$udom,$uname) +=item * &check_if_partid_hidden($id,$symb,$udom,$uname) Returns either 1 or undef @@ -7279,7 +7389,7 @@ sub check_if_partid_hidden { =over 4 -=item get_cgi_id +=item * &get_cgi_id() Inputs: none @@ -7303,7 +7413,7 @@ sub get_cgi_id { =pod -=item DrawBarGraph +=item * &DrawBarGraph() Facilitates the plotting of data in a (stacked) bar graph. Puts plot definition data into the users environment in order for @@ -7438,7 +7548,7 @@ sub DrawBarGraph { $ValuesHash{$id.'.'.$key} = $value; } # - &Apache::lonnet::appenv(%ValuesHash); + &Apache::lonnet::appenv(\%ValuesHash); return ''; } @@ -7447,7 +7557,7 @@ sub DrawBarGraph { =pod -=item DrawXYGraph +=item * &DrawXYGraph() Facilitates the plotting of data in an XY graph. Puts plot definition data into the users environment in order for @@ -7528,7 +7638,7 @@ sub DrawXYGraph { $ValuesHash{$id.'.'.$key} = $value; } # - &Apache::lonnet::appenv(%ValuesHash); + &Apache::lonnet::appenv(\%ValuesHash); return ''; } @@ -7537,7 +7647,7 @@ sub DrawXYGraph { =pod -=item DrawXYYGraph +=item * &DrawXYYGraph() Facilitates the plotting of data in an XY graph with two Y axes. Puts plot definition data into the users environment in order for @@ -7630,7 +7740,7 @@ sub DrawXYYGraph { $ValuesHash{$id.'.'.$key} = $value; } # - &Apache::lonnet::appenv(%ValuesHash); + &Apache::lonnet::appenv(\%ValuesHash); return ''; } @@ -7647,7 +7757,7 @@ Bad place for them but what the hell. =over 4 -=item &chartlink +=item * &chartlink() Returns a link to the chart for a specific student. @@ -7686,9 +7796,9 @@ sub chartlink { =over 4 -=item &restore_course_settings +=item * &restore_course_settings() -=item &store_course_settings +=item * &store_course_settings() Restores/Store indicated form parameters from the course environment. Will not overwrite existing values of the form parameters. @@ -7762,7 +7872,7 @@ sub store_settings { 'got error:'.$put_result); } # Make sure these settings stick around in this session, too - &Apache::lonnet::appenv(%AppHash); + &Apache::lonnet::appenv(\%AppHash); return; } @@ -7799,7 +7909,7 @@ sub restore_settings { =over 4 -=item &build_recipient_list +=item * &build_recipient_list() Build recipient lists for three types of e-mail: (a) Error Reports, (b) Package Updates, (c) Help requests, generated by