|
version 1.627, 2007/12/21 05:19:04
|
version 1.649, 2008/03/24 01:11:36
|
|
Line 78 my $readit;
|
Line 78 my $readit;
|
| ## Global Variables |
## Global Variables |
| ## |
## |
| |
|
| |
|
| |
# ----------------------------------------------- SSI with retries: |
| |
# |
| |
|
| |
=pod |
| |
|
| |
=head1 Server Side include with retries: |
| |
|
| |
=over 4 |
| |
|
| |
=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. |
| |
|
| |
=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 { |
| |
my ($resource, $retries, %form) = @_; |
| |
|
| |
|
| |
my $ok = 0; # True if we got a good response. |
| |
my $content; |
| |
my $response; |
| |
|
| |
# Try to get the ssi done. within the retries count: |
| |
|
| |
do { |
| |
($content, $response) = &Apache::lonnet::ssi($resource, %form); |
| |
$ok = $response->is_success; |
| |
$retries--; |
| |
} while (!$ok && ($retries > 0)); |
| |
|
| |
if (!$ok) { |
| |
$content = ''; # On error return an empty content. |
| |
} |
| |
return ($content, $response); |
| |
|
| |
} |
| |
|
| |
|
| |
|
| # ----------------------------------------------- Filetypes/Languages/Copyright |
# ----------------------------------------------- Filetypes/Languages/Copyright |
| my %language; |
my %language; |
| my %supported_language; |
my %supported_language; |
|
Line 214 BEGIN {
|
Line 281 BEGIN {
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item * browser_and_searcher_javascript () |
=item * &browser_and_searcher_javascript() |
| |
|
| X<browsing, javascript>X<searching, javascript>Returns a string |
X<browsing, javascript>X<searching, javascript>Returns a string |
| containing javascript with two functions, C<openbrowser> and |
containing javascript with two functions, C<openbrowser> and |
| C<opensearcher>. Returned string does not contain E<lt>scriptE<gt> |
C<opensearcher>. Returned string does not contain E<lt>scriptE<gt> |
| tags. |
tags. |
| |
|
| =item * openbrowser(formname,elementname,only,omit) [javascript] |
=item * &openbrowser(formname,elementname,only,omit) [javascript] |
| |
|
| inputs: formname, elementname, only, omit |
inputs: formname, elementname, only, omit |
| |
|
|
Line 234 with the given extension. Can be a comm
|
Line 301 with the given extension. Can be a comm
|
| Specifying 'omit' will restrict the browser to NOT displaying files |
Specifying 'omit' will restrict the browser to NOT displaying files |
| with the given extension. Can be a comma separated list. |
with the given extension. Can be a comma separated list. |
| |
|
| =item * opensearcher(formname, elementname) [javascript] |
=item * &opensearcher(formname,elementname) [javascript] |
| |
|
| Inputs: formname, elementname |
Inputs: formname, elementname |
| |
|
|
Line 319 sub storeresurl {
|
Line 386 sub storeresurl {
|
| unless ($resurl=~/^\/res/) { return 0; } |
unless ($resurl=~/^\/res/) { return 0; } |
| $resurl=~s/\/$//; |
$resurl=~s/\/$//; |
| &Apache::lonnet::put('environment',{'lastresurl' => $resurl}); |
&Apache::lonnet::put('environment',{'lastresurl' => $resurl}); |
| &Apache::lonnet::appenv('environment.lastresurl' => $resurl); |
&Apache::lonnet::appenv({'environment.lastresurl' => $resurl}); |
| return 1; |
return 1; |
| } |
} |
| |
|
|
Line 472 sub setsec_javascript {
|
Line 539 sub setsec_javascript {
|
| my ($sec_element,$formname) = @_; |
my ($sec_element,$formname) = @_; |
| my $setsections = qq| |
my $setsections = qq| |
| function setSect(sectionlist) { |
function setSect(sectionlist) { |
| var sectionsArray = sectionlist.split(","); |
var sectionsArray = new Array(); |
| |
if ((sectionlist != '') && (typeof sectionlist != "undefined")) { |
| |
sectionsArray = sectionlist.split(","); |
| |
} |
| var numSections = sectionsArray.length; |
var numSections = sectionsArray.length; |
| document.$formname.$sec_element.length = 0; |
document.$formname.$sec_element.length = 0; |
| if (numSections == 0) { |
if (numSections == 0) { |
|
Line 539 ENDSCRT
|
Line 609 ENDSCRT
|
| |
|
| =pod |
=pod |
| |
|
| =item * linked_select_forms(...) |
=item * &linked_select_forms(...) |
| |
|
| linked_select_forms returns a string containing a <script></script> block |
linked_select_forms returns a string containing a <script></script> block |
| and html for two <select> menus. The select menus will be linked in that |
and html for two <select> menus. The select menus will be linked in that |
|
Line 704 END
|
Line 774 END
|
| |
|
| =pod |
=pod |
| |
|
| =item * help_open_topic($topic, $text, $stayOnPage, $width, $height) |
=item * &help_open_topic($topic,$text,$stayOnPage,$width,$height) |
| |
|
| Returns a string corresponding to an HTML link to the given help |
Returns a string corresponding to an HTML link to the given help |
| $topic, where $topic corresponds to the name of a .tex file in |
$topic, where $topic corresponds to the name of a .tex file in |
|
Line 758 sub help_open_topic {
|
Line 828 sub help_open_topic {
|
| |
|
| # Add the graphic |
# Add the graphic |
| my $title = &mt('Online Help'); |
my $title = &mt('Online Help'); |
| my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif"); |
my $helpicon=&lonhttpdurl("/res/adm/pages/help.png"); |
| $template .= <<"ENDTEMPLATE"; |
$template .= <<"ENDTEMPLATE"; |
| <a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a> |
<a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a> |
| ENDTEMPLATE |
ENDTEMPLATE |
|
Line 779 sub helpLatexCheatsheet {
|
Line 849 sub helpLatexCheatsheet {
|
| } |
} |
| return '<table><tr><td>'. |
return '<table><tr><td>'. |
| $addOther . |
$addOther . |
| &Apache::loncommon::help_open_topic("Greek_Symbols",'Greek Symbols', |
&Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'), |
| undef,undef,600) |
undef,undef,600) |
| .'</td><td>'. |
.'</td><td>'. |
| &Apache::loncommon::help_open_topic("Other_Symbols",'Other Symbols', |
&Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'), |
| undef,undef,600) |
undef,undef,600) |
| .'</td></tr></table>'; |
.'</td></tr></table>'; |
| } |
} |
|
Line 1014 ENDTEMPLATE
|
Line 1084 ENDTEMPLATE
|
| |
|
| =pod |
=pod |
| |
|
| =item * change_content_javascript(): |
=item * &change_content_javascript(): |
| |
|
| This and the next function allow you to create small sections of an |
This and the next function allow you to create small sections of an |
| otherwise static HTML page that you can update on the fly with |
otherwise static HTML page that you can update on the fly with |
|
Line 1069 DOMBASED
|
Line 1139 DOMBASED
|
| |
|
| =pod |
=pod |
| |
|
| =item * changable_area($name, $origContent): |
=item * &changable_area($name,$origContent): |
| |
|
| This provides a "changable area" that can be modified on the fly via |
This provides a "changable area" that can be modified on the fly via |
| the Javascript code provided in C<change_content_javascript>. $name is |
the Javascript code provided in C<change_content_javascript>. $name is |
|
Line 1093 sub changable_area {
|
Line 1163 sub changable_area {
|
| |
|
| =pod |
=pod |
| |
|
| =item * viewport_geometry_js { |
=item * &viewport_geometry_js |
| |
|
| Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser. |
Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser. |
| |
|
|
Line 1140 GEOMETRY
|
Line 1210 GEOMETRY
|
| |
|
| =pod |
=pod |
| |
|
| =item * viewport_size_js { |
=item * &viewport_size_js() |
| |
|
| Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window. |
Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window. |
| |
|
|
Line 1164 DIMS
|
Line 1234 DIMS
|
| |
|
| =pod |
=pod |
| |
|
| =item * resize_textarea_js |
=item * &resize_textarea_js() |
| |
|
| emits the needed javascript to resize a textarea to be as big as possible |
emits the needed javascript to resize a textarea to be as big as possible |
| |
|
|
Line 1173 the id of the element to resize, second
|
Line 1243 the id of the element to resize, second
|
| surrounds everything that comes after the textarea, this routine needs |
surrounds everything that comes after the textarea, this routine needs |
| to be attached to the <body> for the onload and onresize events. |
to be attached to the <body> for the onload and onresize events. |
| |
|
| |
=back |
| |
|
| =cut |
=cut |
| |
|
|
Line 1225 RESIZE
|
Line 1296 RESIZE
|
| |
|
| =pod |
=pod |
| |
|
| =back |
|
| |
|
| =head1 Excel and CSV file utility routines |
=head1 Excel and CSV file utility routines |
| |
|
| =over 4 |
=over 4 |
|
Line 1238 RESIZE
|
Line 1307 RESIZE
|
| |
|
| =pod |
=pod |
| |
|
| =item * csv_translate($text) |
=item * &csv_translate($text) |
| |
|
| Translate $text to allow it to be output as a 'comma separated values' |
Translate $text to allow it to be output as a 'comma separated values' |
| format. |
format. |
|
Line 1259 sub csv_translate {
|
Line 1328 sub csv_translate {
|
| |
|
| =pod |
=pod |
| |
|
| =item * define_excel_formats |
=item * &define_excel_formats() |
| |
|
| Define some commonly used Excel cell formats. |
Define some commonly used Excel cell formats. |
| |
|
|
Line 1315 sub define_excel_formats {
|
Line 1384 sub define_excel_formats {
|
| |
|
| =pod |
=pod |
| |
|
| =item * create_workbook |
=item * &create_workbook() |
| |
|
| Create an Excel worksheet. If it fails, output message on the |
Create an Excel worksheet. If it fails, output message on the |
| request object and return undefs. |
request object and return undefs. |
|
Line 1358 sub create_workbook {
|
Line 1427 sub create_workbook {
|
| |
|
| =pod |
=pod |
| |
|
| =item * create_text_file |
=item * &create_text_file() |
| |
|
| Create a file to write to and eventually make available to the user. |
Create a file to write to and eventually make available to the user. |
| If file creation fails, outputs an error message on the request object and |
If file creation fails, outputs an error message on the request object and |
|
Line 1426 sub domain_select {
|
Line 1495 sub domain_select {
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item * multiple_select_form($name,$value,$size,$hash,$order) |
=item * &multiple_select_form($name,$value,$size,$hash,$order) |
| |
|
| Returns a string containing a <select> element int multiple mode |
Returns a string containing a <select> element int multiple mode |
| |
|
|
Line 1476 sub multiple_select_form {
|
Line 1545 sub multiple_select_form {
|
| |
|
| =pod |
=pod |
| |
|
| =item * select_form($defdom,$name,%hash) |
=item * &select_form($defdom,$name,%hash) |
| |
|
| Returns a string containing a <select name='$name' size='1'> form to |
Returns a string containing a <select name='$name' size='1'> form to |
| allow a user to select options from a hash option_name => displayed text. |
allow a user to select options from a hash option_name => displayed text. |
|
Line 1563 sub select_level_form {
|
Line 1632 sub select_level_form {
|
| |
|
| =pod |
=pod |
| |
|
| =item * select_dom_form($defdom,$name,$includeempty,$showdomdesc) |
=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc) |
| |
|
| Returns a string containing a <select name='$name' size='1'> form to |
Returns a string containing a <select name='$name' size='1'> form to |
| allow a user to select the domain to preform an operation in. |
allow a user to select the domain to preform an operation in. |
|
Line 1603 sub select_dom_form {
|
Line 1672 sub select_dom_form {
|
| |
|
| =pod |
=pod |
| |
|
| =item * home_server_form_item($domain,$name,$defaultflag) |
=item * &home_server_form_item($domain,$name,$defaultflag) |
| |
|
| input: 4 arguments (two required, two optional) - |
input: 4 arguments (two required, two optional) - |
| $domain - domain of new user |
$domain - domain of new user |
|
Line 1763 sub decode_user_agent {
|
Line 1832 sub decode_user_agent {
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item * authform_xxxxxx |
=item * &authform_xxxxxx() |
| |
|
| The authform_xxxxxx subroutines provide javascript and html forms which |
The authform_xxxxxx subroutines provide javascript and html forms which |
| handle some of the conveniences required for authentication forms. |
handle some of the conveniences required for authentication forms. |
| This is not an optimal method, but it works. |
This is not an optimal method, but it works. |
| |
|
| See loncreateuser.pm for invocation and use examples. |
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item * authform_header |
=item * authform_header |
|
Line 1787 See loncreateuser.pm for invocation and
|
Line 1854 See loncreateuser.pm for invocation and
|
| |
|
| =back |
=back |
| |
|
| =back |
See loncreateuser.pm for invocation and use examples. |
| |
|
| =cut |
=cut |
| |
|
|
Line 2239 sub get_assignable_auth {
|
Line 2306 sub get_assignable_auth {
|
| } |
} |
| |
|
| ############################################################### |
############################################################### |
| ## Get Authentication Defaults for Domain ## |
|
| ############################################################### |
|
| |
|
| =pod |
|
| |
|
| =head1 Domains and Authentication |
|
| |
|
| Returns default authentication type and an associated argument as |
|
| listed in file 'domain.tab'. |
|
| |
|
| =over 4 |
|
| |
|
| =item * get_auth_defaults |
|
| |
|
| get_auth_defaults($target_domain) returns the default authentication |
|
| type and an associated argument (initial password or a kerberos domain). |
|
| These values are stored in lonTabs/domain.tab |
|
| |
|
| ($def_auth, $def_arg) = &get_auth_defaults($target_domain); |
|
| |
|
| If target_domain is not found in domain.tab, returns nothing (''). |
|
| |
|
| =cut |
|
| |
|
| #------------------------------------------- |
|
| sub get_auth_defaults { |
|
| my $domain=shift; |
|
| return (&Apache::lonnet::domain($domain,'auth_def'), |
|
| &Apache::lonnet::domain($domain,'auth_arg_def')); |
|
| |
|
| } |
|
| ############################################################### |
|
| ## End Get Authentication Defaults for Domain ## |
|
| ############################################################### |
|
| |
|
| ############################################################### |
|
| ## Get Kerberos Defaults for Domain ## |
## Get Kerberos Defaults for Domain ## |
| ############################################################### |
############################################################### |
| ## |
## |
|
Line 2286 sub get_auth_defaults {
|
Line 2317 sub get_auth_defaults {
|
| |
|
| =pod |
=pod |
| |
|
| =item * get_kerberos_defaults |
=item * &get_kerberos_defaults() |
| |
|
| get_kerberos_defaults($target_domain) returns the default kerberos |
get_kerberos_defaults($target_domain) returns the default kerberos |
| version and domain. If not found in domain.tabs, it defaults to |
version and domain. If not found, it defaults to version 4 and the |
| version 4 and the domain of the server. |
domain of the server. |
| |
|
| |
=over 4 |
| |
|
| ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain); |
($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain); |
| |
|
| |
=back |
| |
|
| |
=back |
| |
|
| =cut |
=cut |
| |
|
| #------------------------------------------- |
#------------------------------------------- |
| sub get_kerberos_defaults { |
sub get_kerberos_defaults { |
| my $domain=shift; |
my $domain=shift; |
| my ($krbdef,$krbdefdom) = |
my ($krbdef,$krbdefdom); |
| &Apache::loncommon::get_auth_defaults($domain); |
my %domdefaults = &Apache::lonnet::get_domain_defaults($domain); |
| unless ($krbdef =~/^krb/ && $krbdefdom) { |
if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) { |
| |
$krbdef = $domdefaults{'auth_def'}; |
| |
$krbdefdom = $domdefaults{'auth_arg_def'}; |
| |
} else { |
| $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/; |
$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/; |
| my $krbdefdom=$1; |
my $krbdefdom=$1; |
| $krbdefdom=~tr/a-z/A-Z/; |
$krbdefdom=~tr/a-z/A-Z/; |
|
Line 2310 sub get_kerberos_defaults {
|
Line 2350 sub get_kerberos_defaults {
|
| return ($krbdef,$krbdefdom); |
return ($krbdef,$krbdefdom); |
| } |
} |
| |
|
| =pod |
|
| |
|
| =back |
|
| |
|
| =cut |
|
| |
|
| ############################################################### |
############################################################### |
| ## Thesaurus Functions ## |
## Thesaurus Functions ## |
|
Line 2326 sub get_kerberos_defaults {
|
Line 2361 sub get_kerberos_defaults {
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item * initialize_keywords |
=item * &initialize_keywords() |
| |
|
| Initializes the package variable %Keywords if it is empty. Uses the |
Initializes the package variable %Keywords if it is empty. Uses the |
| package variable $thesaurus_db_file. |
package variable $thesaurus_db_file. |
|
Line 2371 sub initialize_keywords {
|
Line 2406 sub initialize_keywords {
|
| |
|
| =pod |
=pod |
| |
|
| =item * keyword($word) |
=item * &keyword($word) |
| |
|
| Returns true if $word is a keyword. A keyword is a word that appears more |
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 |
than the average number of times in the thesaurus database. Calls |
|
Line 2392 sub keyword {
|
Line 2427 sub keyword {
|
| |
|
| =pod |
=pod |
| |
|
| =item * get_related_words |
=item * &get_related_words() |
| |
|
| Look up a word in the thesaurus. Takes a scalar argument and returns |
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 |
an array of words. If the keyword is not in the thesaurus, an empty array |
|
Line 2450 sub get_related_words {
|
Line 2485 sub get_related_words {
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item * plainname($uname,$udom,$first) |
=item * &plainname($uname,$udom,$first) |
| |
|
| Takes a users logon name and returns it as a string in |
Takes a users logon name and returns it as a string in |
| "first middle last generation" form |
"first middle last generation" form |
|
Line 2479 sub plainname {
|
Line 2514 sub plainname {
|
| # -------------------------------------------------------------------- Nickname |
# -------------------------------------------------------------------- Nickname |
| =pod |
=pod |
| |
|
| =item * nickname($uname,$udom) |
=item * &nickname($uname,$udom) |
| |
|
| Gets a users name and returns it as a string as |
Gets a users name and returns it as a string as |
| |
|
|
Line 2529 sub getnames {
|
Line 2564 sub getnames {
|
| } |
} |
| |
|
| # -------------------------------------------------------------------- getemails |
# -------------------------------------------------------------------- getemails |
| |
|
| =pod |
=pod |
| |
|
| =item * getemails($uname,$udom) |
=item * &getemails($uname,$udom) |
| |
|
| Gets a user's email information and returns it as a hash with keys: |
Gets a user's email information and returns it as a hash with keys: |
| notification, critnotification, permanentemail |
notification, critnotification, permanentemail |
| |
|
| For notification and critnotification, values are comma-separated lists |
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 |
=cut |
| |
|
| |
|
| sub getemails { |
sub getemails { |
| my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
| if ($udom eq 'public' && $uname eq 'public') { |
if ($udom eq 'public' && $uname eq 'public') { |
|
Line 2575 sub flush_email_cache {
|
Line 2613 sub flush_email_cache {
|
| |
|
| =pod |
=pod |
| |
|
| =item * screenname($uname,$udom) |
=item * &screenname($uname,$udom) |
| |
|
| Gets a users screenname and returns it as a string |
Gets a users screenname and returns it as a string |
| |
|
|
Line 2671 sub student_image_tag {
|
Line 2709 sub student_image_tag {
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item * languageids() |
=item * &languageids() |
| |
|
| returns list of all language ids |
returns list of all language ids |
| |
|
|
Line 2683 sub languageids {
|
Line 2721 sub languageids {
|
| |
|
| =pod |
=pod |
| |
|
| =item * languagedescription() |
=item * &languagedescription() |
| |
|
| returns description of a specified language id |
returns description of a specified language id |
| |
|
|
Line 2708 sub supportedlanguagecode {
|
Line 2746 sub supportedlanguagecode {
|
| |
|
| =pod |
=pod |
| |
|
| =item * copyrightids() |
=item * ©rightids() |
| |
|
| returns list of all copyrights |
returns list of all copyrights |
| |
|
|
Line 2720 sub copyrightids {
|
Line 2758 sub copyrightids {
|
| |
|
| =pod |
=pod |
| |
|
| =item * copyrightdescription() |
=item * ©rightdescription() |
| |
|
| returns description of a specified copyright id |
returns description of a specified copyright id |
| |
|
|
Line 2732 sub copyrightdescription {
|
Line 2770 sub copyrightdescription {
|
| |
|
| =pod |
=pod |
| |
|
| =item * source_copyrightids() |
=item * &source_copyrightids() |
| |
|
| returns list of all source copyrights |
returns list of all source copyrights |
| |
|
|
Line 2744 sub source_copyrightids {
|
Line 2782 sub source_copyrightids {
|
| |
|
| =pod |
=pod |
| |
|
| =item * source_copyrightdescription() |
=item * &source_copyrightdescription() |
| |
|
| returns description of a specified source copyright id |
returns description of a specified source copyright id |
| |
|
|
Line 2756 sub source_copyrightdescription {
|
Line 2794 sub source_copyrightdescription {
|
| |
|
| =pod |
=pod |
| |
|
| =item * filecategories() |
=item * &filecategories() |
| |
|
| returns list of all file categories |
returns list of all file categories |
| |
|
|
Line 2768 sub filecategories {
|
Line 2806 sub filecategories {
|
| |
|
| =pod |
=pod |
| |
|
| =item * filecategorytypes() |
=item * &filecategorytypes() |
| |
|
| returns list of file types belonging to a given file |
returns list of file types belonging to a given file |
| category |
category |
|
Line 2782 sub filecategorytypes {
|
Line 2820 sub filecategorytypes {
|
| |
|
| =pod |
=pod |
| |
|
| =item * fileembstyle() |
=item * &fileembstyle() |
| |
|
| returns embedding style for a specified file type |
returns embedding style for a specified file type |
| |
|
|
Line 2806 sub filecategoryselect {
|
Line 2844 sub filecategoryselect {
|
| |
|
| =pod |
=pod |
| |
|
| =item * filedescription() |
=item * &filedescription() |
| |
|
| returns description for a specified file type |
returns description for a specified file type |
| |
|
|
Line 2820 sub filedescription {
|
Line 2858 sub filedescription {
|
| |
|
| =pod |
=pod |
| |
|
| =item * filedescriptionex() |
=item * &filedescriptionex() |
| |
|
| returns description for a specified file type with |
returns description for a specified file type with |
| extra formatting |
extra formatting |
|
Line 2880 sub preferred_languages {
|
Line 2918 sub preferred_languages {
|
| map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser)); |
map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser)); |
| push(@languages,@browser); |
push(@languages,@browser); |
| } |
} |
| if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) { |
|
| @languages=(@languages, |
foreach my $domtype ($env{'user.domain'},$env{'request.role.domain'}, |
| &Apache::lonnet::domain($env{'user.domain'}, |
$Apache::lonnet::perlvar{'lonDefDomain'}) { |
| 'lang_def')); |
if ($domtype ne '') { |
| } |
my %domdefs = &Apache::lonnet::get_domain_defaults($domtype); |
| if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) { |
if ($domdefs{'lang_def'} ne '') { |
| @languages=(@languages, |
push(@languages,$domdefs{'lang_def'}); |
| &Apache::lonnet::domain($env{'request.role.domain'}, |
} |
| 'lang_def')); |
} |
| } |
|
| if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'}, |
|
| 'lang_def')) { |
|
| @languages=(@languages, |
|
| &Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'}, |
|
| 'lang_def')); |
|
| } |
} |
| # turn "en-ca" into "en-ca,en" |
# turn "en-ca" into "en-ca,en" |
| my @genlanguages; |
my @genlanguages; |
|
Line 2944 sub languages {
|
Line 2976 sub languages {
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item * get_previous_attempt($symb, $username, $domain, $course, |
=item * &get_previous_attempt($symb, $username, $domain, $course, |
| $getattempt, $regexp, $gradesub) |
$getattempt, $regexp, $gradesub) |
| |
|
| Return string with previous attempt on problem. Arguments: |
Return string with previous attempt on problem. Arguments: |
|
Line 3088 sub relative_to_absolute {
|
Line 3120 sub relative_to_absolute {
|
| |
|
| =pod |
=pod |
| |
|
| =item * get_student_view |
=item * &get_student_view() |
| |
|
| show a snapshot of what student was looking at |
show a snapshot of what student was looking at |
| |
|
|
Line 3121 sub get_student_view {
|
Line 3153 sub get_student_view {
|
| |
|
| =pod |
=pod |
| |
|
| =item * get_student_answers() |
=item * &get_student_answers() |
| |
|
| show a snapshot of how student was answering problem |
show a snapshot of how student was answering problem |
| |
|
|
Line 3667 sub get_domainconf {
|
Line 3699 sub get_domainconf {
|
| |
|
| my %domconfig = &Apache::lonnet::get_dom('configuration', |
my %domconfig = &Apache::lonnet::get_dom('configuration', |
| ['login','rolecolors'],$udom); |
['login','rolecolors'],$udom); |
| my %designhash; |
my (%designhash,%legacy); |
| if (keys(%domconfig) > 0) { |
if (keys(%domconfig) > 0) { |
| if (ref($domconfig{'login'}) eq 'HASH') { |
if (ref($domconfig{'login'}) eq 'HASH') { |
| foreach my $key (keys(%{$domconfig{'login'}})) { |
if (keys(%{$domconfig{'login'}})) { |
| $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key}; |
foreach my $key (keys(%{$domconfig{'login'}})) { |
| |
$designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key}; |
| |
} |
| |
} else { |
| |
$legacy{'login'} = 1; |
| } |
} |
| |
} else { |
| |
$legacy{'login'} = 1; |
| } |
} |
| if (ref($domconfig{'rolecolors'}) eq 'HASH') { |
if (ref($domconfig{'rolecolors'}) eq 'HASH') { |
| foreach my $role (keys(%{$domconfig{'rolecolors'}})) { |
if (keys(%{$domconfig{'rolecolors'}})) { |
| if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') { |
foreach my $role (keys(%{$domconfig{'rolecolors'}})) { |
| foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) { |
if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') { |
| $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item}; |
foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) { |
| |
$designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item}; |
| |
} |
| } |
} |
| } |
} |
| |
} else { |
| |
$legacy{'rolecolors'} = 1; |
| } |
} |
| |
} else { |
| |
$legacy{'rolecolors'} = 1; |
| } |
} |
| } else { |
if (keys(%legacy) > 0) { |
| my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; |
my %legacyhash = &get_legacy_domconf($udom); |
| my $designfile = $designdir.'/'.$udom.'.tab'; |
foreach my $item (keys(%legacyhash)) { |
| if (-e $designfile) { |
if ($item =~ /^\Q$udom\E\.login/) { |
| if ( open (my $fh,"<$designfile") ) { |
if ($legacy{'login'}) { |
| while (my $line = <$fh>) { |
$designhash{$item} = $legacyhash{$item}; |
| next if ($line =~ /^\#/); |
} |
| chomp($line); |
} else { |
| my ($key,$val)=(split(/\=/,$line)); |
if ($legacy{'rolecolors'}) { |
| if ($val) { $designhash{$udom.'.'.$key}=$val; } |
$designhash{$item} = $legacyhash{$item}; |
| |
} |
| } |
} |
| close($fh); |
|
| } |
} |
| } |
} |
| if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') { |
} else { |
| $designhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif"; |
%designhash = &get_legacy_domconf($udom); |
| } |
|
| } |
} |
| &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash, |
&Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash, |
| $cachetime); |
$cachetime); |
| return %designhash; |
return %designhash; |
| } |
} |
| |
|
| |
sub get_legacy_domconf { |
| |
my ($udom) = @_; |
| |
my %legacyhash; |
| |
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; |
| |
my $designfile = $designdir.'/'.$udom.'.tab'; |
| |
if (-e $designfile) { |
| |
if ( open (my $fh,"<$designfile") ) { |
| |
while (my $line = <$fh>) { |
| |
next if ($line =~ /^\#/); |
| |
chomp($line); |
| |
my ($key,$val)=(split(/\=/,$line)); |
| |
if ($val) { $legacyhash{$udom.'.'.$key}=$val; } |
| |
} |
| |
close($fh); |
| |
} |
| |
} |
| |
if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') { |
| |
$legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif"; |
| |
} |
| |
return %legacyhash; |
| |
} |
| |
|
| =pod |
=pod |
| |
|
| =item * &domainlogo() |
=item * &domainlogo() |
|
Line 3755 Returns: value of designparamter $which
|
Line 3820 Returns: value of designparamter $which
|
| sub designparm { |
sub designparm { |
| my ($which,$domain)=@_; |
my ($which,$domain)=@_; |
| if ($env{'browser.blackwhite'} eq 'on') { |
if ($env{'browser.blackwhite'} eq 'on') { |
| if ($which=~/\.(font|alink|vlink|link)$/) { |
if ($which=~/\.(font|alink|vlink|link|textcol)$/) { |
| return '#000000'; |
return '#000000'; |
| } |
} |
| if ($which=~/\.(pgbg|sidebg)$/) { |
if ($which=~/\.(pgbg|sidebg|bgcol)$/) { |
| return '#FFFFFF'; |
return '#FFFFFF'; |
| } |
} |
| if ($which=~/\.tabbg$/) { |
if ($which=~/\.tabbg$/) { |
|
Line 3777 sub designparm {
|
Line 3842 sub designparm {
|
| $output = $defaultdesign{$which}; |
$output = $defaultdesign{$which}; |
| } |
} |
| if (($which =~ /^(student|coordinator|author|admin)\.img$/) || |
if (($which =~ /^(student|coordinator|author|admin)\.img$/) || |
| ($which =~ /login\.(img|logo|domlogo)/)) { |
($which =~ /login\.(img|logo|domlogo|login)/)) { |
| if ($output =~ m{^/(adm|res)/}) { |
if ($output =~ m{^/(adm|res)/}) { |
| if ($output =~ m{^/res/}) { |
if ($output =~ m{^/res/}) { |
| my $local_name = &Apache::lonnet::filelocation('',$output); |
my $local_name = &Apache::lonnet::filelocation('',$output); |
|
Line 3945 ENDROLE
|
Line 4010 ENDROLE
|
| $dc_info = '('.$dc_info.')'; |
$dc_info = '('.$dc_info.')'; |
| } |
} |
| |
|
| if ($env{'environment.remote'} eq 'off') { |
if (($env{'environment.remote'} eq 'off') || ($args->{'suppress_header_logos'})) { |
| # No Remote |
# No Remote |
| if ($env{'request.state'} eq 'construct') { |
if ($env{'request.state'} eq 'construct') { |
| $forcereg=1; |
$forcereg=1; |
|
Line 3968 ENDROLE
|
Line 4033 ENDROLE
|
| $lastitem = $thisdisfn; |
$lastitem = $thisdisfn; |
| } |
} |
| $titleinfo = |
$titleinfo = |
| &Apache::loncommon::help_open_menu('','',3,'Authoring'). |
&Apache::loncommon::help_open_menu('','',3,'Authoring') |
| '<b>Construction Space</b>: '. |
.'<b>'.&mt('Construction Space').'</b>: ' |
| '<form name="dirs" method="post" action="'.$formaction |
.'<form name="dirs" method="post" action="'.$formaction |
| .'" target="_top"><tt><b>' |
.'" target="_top"><tt><b>' |
| .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />" |
.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />" |
| .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') |
.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') |
|
Line 4094 sub make_attr_string {
|
Line 4159 sub make_attr_string {
|
| |
|
| Returns a uniform footer for LON-CAPA web pages. |
Returns a uniform footer for LON-CAPA web pages. |
| |
|
| Inputs: none |
Inputs: 1 - optional reference to an args hash |
| |
If in the hash, key for noredirectlink has a value which evaluates to true, |
| |
a 'Continue' link is not displayed if the page contains an |
| |
internal redirect in the <head></head> section, |
| |
i.e., $env{'internal.head.redirect'} exists |
| |
|
| =cut |
=cut |
| |
|
| sub endbodytag { |
sub endbodytag { |
| |
my ($args) = @_; |
| my $endbodytag='</body>'; |
my $endbodytag='</body>'; |
| $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag; |
$endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag; |
| if ( exists( $env{'internal.head.redirect'} ) ) { |
if ( exists( $env{'internal.head.redirect'} ) ) { |
| $endbodytag= |
if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) { |
| "<br /><a href=\"$env{'internal.head.redirect'}\">". |
$endbodytag= |
| &mt('Continue').'</a>'. |
"<br /><a href=\"$env{'internal.head.redirect'}\">". |
| $endbodytag; |
&mt('Continue').'</a>'. |
| |
$endbodytag; |
| |
} |
| } |
} |
| return $endbodytag; |
return $endbodytag; |
| } |
} |
|
Line 4368 td.LC_menubuttons_img {
|
Line 4440 td.LC_menubuttons_img {
|
| } |
} |
| .LC_new_mail { |
.LC_new_mail { |
| font-family: $sans; |
font-family: $sans; |
| |
background: $tabbg; |
| font-weight: bold; |
font-weight: bold; |
| } |
} |
| |
|
|
Line 4454 table.LC_aboutme_port tr.LC_even_row td
|
Line 4527 table.LC_aboutme_port tr.LC_even_row td
|
| table.LC_data_table tr.LC_data_table_highlight td { |
table.LC_data_table tr.LC_data_table_highlight td { |
| background-color: $data_table_darker; |
background-color: $data_table_darker; |
| } |
} |
| |
table.LC_data_table tr td.LC_leftcol_header { |
| |
background-color: $data_table_head; |
| |
font-weight: bold; |
| |
} |
| table.LC_data_table tr.LC_empty_row td, |
table.LC_data_table tr.LC_empty_row td, |
| table.LC_nested tr.LC_empty_row td { |
table.LC_nested tr.LC_empty_row td { |
| background-color: #FFFFFF; |
background-color: #FFFFFF; |
|
Line 4729 table.LC_pick_box td.LC_pick_box_title {
|
Line 4806 table.LC_pick_box td.LC_pick_box_title {
|
| width: 184px; |
width: 184px; |
| padding: 8px; |
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 { |
table.LC_pick_box td.LC_pick_box_value { |
| text-align: left; |
text-align: left; |
| padding: 8px; |
padding: 8px; |
|
Line 4943 span.LC_cusr_emph {
|
Line 5028 span.LC_cusr_emph {
|
| font-style: italic; |
font-style: italic; |
| } |
} |
| |
|
| |
span.LC_cusr_subheading { |
| |
font-weight: normal; |
| |
font-size: 85%; |
| |
} |
| |
|
| table.LC_docs_documents { |
table.LC_docs_documents { |
| background: #BBBBBB; |
background: #BBBBBB; |
| border-width: 0px; |
border-width: 0px; |
|
Line 5268 Inputs: none
|
Line 5358 Inputs: none
|
| |
|
| sub font_settings { |
sub font_settings { |
| my $headerstring=''; |
my $headerstring=''; |
| if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) { |
if (!$env{'browser.mathml'} && $env{'browser.unicode'}) { |
| $headerstring.= |
|
| '<meta Content-Type="text/html; charset=x-mac-roman" />'; |
|
| } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) { |
|
| $headerstring.= |
$headerstring.= |
| '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'; |
'<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'; |
| } |
} |
|
Line 5330 sub endheadtag {
|
Line 5417 sub endheadtag {
|
| |
|
| Returns a uniform complete <head>..</head> section for LON-CAPA web pages. |
Returns a uniform complete <head>..</head> section for LON-CAPA web pages. |
| |
|
| Inputs: $title - optional title for the page |
Inputs: |
| $head_extra - optional extra HTML to put inside the <head> |
|
| |
=over 4 |
| |
|
| |
$title - optional title for the page |
| |
|
| |
$head_extra - optional extra HTML to put inside the <head> |
| |
|
| |
=back |
| |
|
| =cut |
=cut |
| |
|
|
Line 5346 sub head {
|
Line 5440 sub head {
|
| |
|
| Returns a complete <html> .. <body> section for LON-CAPA web pages. |
Returns a complete <html> .. <body> section for LON-CAPA web pages. |
| |
|
| Inputs: $title - optional title for the page |
Inputs: |
| $head_extra - optional extra HTML to incude inside the <head> |
|
| $args - additional optional args supported are: |
=over 4 |
| only_body -> is true will set &bodytag() onlybodytag |
|
| |
$title - optional title for the page |
| |
|
| |
$head_extra - optional extra HTML to incude inside the <head> |
| |
|
| |
$args - additional optional args supported are: |
| |
|
| |
=over 8 |
| |
|
| |
only_body -> is true will set &bodytag() onlybodytag |
| arg on |
arg on |
| no_nav_bar -> is true will set &bodytag() notopbar arg on |
no_nav_bar -> is true will set &bodytag() notopbar arg on |
| add_entries -> additional attributes to add to the <body> |
add_entries -> additional attributes to add to the <body> |
| domain -> force to color decorate a page for a |
domain -> force to color decorate a page for a |
| specific domain |
specific domain |
| function -> force usage of a specific rolish color |
function -> force usage of a specific rolish color |
| scheme |
scheme |
| redirect -> see &headtag() |
redirect -> see &headtag() |
| bgcolor -> override the default page bg color |
bgcolor -> override the default page bg color |
| js_ready -> return a string ready for being used in |
js_ready -> return a string ready for being used in |
| a javascript writeln |
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 |
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 |
$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 |
in the title box that appears, this text |
| is not auto translated like the $title is |
is not auto translated like the $title is |
| frameset -> if true will start with a <frameset> |
frameset -> if true will start with a <frameset> |
| rather than <body> |
rather than <body> |
| no_title -> if true the title bar won't be shown |
no_title -> if true the title bar won't be shown |
| skip_phases -> hash ref of |
skip_phases -> hash ref of |
| head -> skip the <html><head> generation |
head -> skip the <html><head> generation |
| body -> skip all <body> generation |
body -> skip all <body> 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 |
'Switch To Inline Menu' link |
| |
no_auto_mt_title -> prevent &mt()ing the title arg |
| no_auto_mt_title -> prevent &mt()ing the title arg |
inherit_jsmath -> when creating popup window in a page, |
| |
|
| inherit_jsmath -> when creating popup window in a page, |
|
| should it have jsmath forced on by the |
should it have jsmath forced on by the |
| current page |
current page |
| |
|
| |
=back |
| |
|
| |
=back |
| |
|
| =cut |
=cut |
| |
|
| sub start_page { |
sub start_page { |
|
Line 5470 sub end_page {
|
Line 5574 sub end_page {
|
| if ($args->{'frameset'}) { |
if ($args->{'frameset'}) { |
| $result .= '</frameset>'; |
$result .= '</frameset>'; |
| } else { |
} else { |
| $result .= &endbodytag(); |
$result .= &endbodytag($args); |
| } |
} |
| $result .= "\n</html>"; |
$result .= "\n</html>"; |
| |
|
|
Line 5848 previous, future, or all.
|
Line 5952 previous, future, or all.
|
| 6. reference to results object (hash of hashes). |
6. reference to results object (hash of hashes). |
| 7. reference to optional userdata hash |
7. reference to optional userdata hash |
| 8. reference to optional statushash |
8. reference to optional statushash |
| |
9. flag if privileged users (except those set to unhide in |
| |
course settings) should be excluded |
| Keys of top level results hash are roles. |
Keys of top level results hash are roles. |
| Keys of inner hashes are username:domain, with |
Keys of inner hashes are username:domain, with |
| values set to access type. |
values set to access type. |
|
Line 5864 of the possibility of multiple values fo
|
Line 5970 of the possibility of multiple values fo
|
| ############################################### |
############################################### |
| |
|
| sub get_course_users { |
sub get_course_users { |
| my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash) = @_; |
my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_; |
| my %idx = (); |
my %idx = (); |
| my %seclists; |
my %seclists; |
| |
|
|
Line 5940 sub get_course_users {
|
Line 6046 sub get_course_users {
|
| active => 'Active', |
active => 'Active', |
| future => 'Future', |
future => 'Future', |
| ); |
); |
| |
my %nothide; |
| |
if ($hidepriv) { |
| |
my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum); |
| |
foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) { |
| |
if ($user !~ /:/) { |
| |
$nothide{join(':',split(/[\@]/,$user))}=1; |
| |
} else { |
| |
$nothide{$user} = 1; |
| |
} |
| |
} |
| |
} |
| foreach my $person (sort(keys(%coursepersonnel))) { |
foreach my $person (sort(keys(%coursepersonnel))) { |
| my $match = 0; |
my $match = 0; |
| my $secmatch = 0; |
my $secmatch = 0; |
|
Line 5973 sub get_course_users {
|
Line 6090 sub get_course_users {
|
| $usec = 'none'; |
$usec = 'none'; |
| } |
} |
| if ($uname ne '' && $udom ne '') { |
if ($uname ne '' && $udom ne '') { |
| |
if ($hidepriv) { |
| |
if ((&Apache::lonnet::privileged($uname,$udom)) && |
| |
(!$nothide{$uname.':'.$udom})) { |
| |
next; |
| |
} |
| |
} |
| if ($end > 0 && $end < $now) { |
if ($end > 0 && $end < $now) { |
| $status = 'previous'; |
$status = 'previous'; |
| } elsif ($start > $now) { |
} elsif ($start > $now) { |
|
Line 6620 sub personal_data_fieldtitles {
|
Line 6743 sub personal_data_fieldtitles {
|
| return %fieldtitles; |
return %fieldtitles; |
| } |
} |
| |
|
| |
sub sorted_inst_types { |
| |
my ($dom) = @_; |
| |
my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); |
| |
my $othertitle = &mt('All users'); |
| |
if ($env{'request.course.id'}) { |
| |
$othertitle = 'any'; |
| |
} |
| |
my @types; |
| |
if (ref($order) eq 'ARRAY') { |
| |
@types = @{$order}; |
| |
} |
| |
if (@types == 0) { |
| |
if (ref($usertypes) eq 'HASH') { |
| |
@types = sort(keys(%{$usertypes})); |
| |
} |
| |
} |
| |
if (keys(%{$usertypes}) > 0) { |
| |
$othertitle = &mt('Other users'); |
| |
if ($env{'request.course.id'}) { |
| |
$othertitle = 'other'; |
| |
} |
| |
} |
| |
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 |
=pod |
| |
|
| =back |
=back |
|
Line 6628 sub personal_data_fieldtitles {
|
Line 6817 sub personal_data_fieldtitles {
|
| |
|
| =over 4 |
=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 |
Modify the %env hash to contain unprocessed CGI form parameters held in |
| $query. The parameters listed in $possible_names (an array reference), |
$query. The parameters listed in $possible_names (an array reference), |
|
Line 6657 sub get_unprocessed_cgi {
|
Line 6846 sub get_unprocessed_cgi {
|
| |
|
| =pod |
=pod |
| |
|
| =item * cacheheader() |
=item * &cacheheader() |
| |
|
| returns cache-controlling header code |
returns cache-controlling header code |
| |
|
|
Line 6674 sub cacheheader {
|
Line 6863 sub cacheheader {
|
| |
|
| =pod |
=pod |
| |
|
| =item * no_cache($r) |
=item * &no_cache($r) |
| |
|
| specifies header code to not have cache |
specifies header code to not have cache |
| |
|
|
Line 6710 sub content_type {
|
Line 6899 sub content_type {
|
| |
|
| =pod |
=pod |
| |
|
| =item * add_to_env($name,$value) |
=item * &add_to_env($name,$value) |
| |
|
| adds $name to the %env hash with value |
adds $name to the %env hash with value |
| $value, if $name already exists, the entry is converted to an array |
$value, if $name already exists, the entry is converted to an array |
|
Line 6737 sub add_to_env {
|
Line 6926 sub add_to_env {
|
| |
|
| =pod |
=pod |
| |
|
| =item * get_env_multiple($name) |
=item * &get_env_multiple($name) |
| |
|
| gets $name from the %env hash, it seemlessly handles the cases where multiple |
gets $name from the %env hash, it seemlessly handles the cases where multiple |
| values may be defined and end up as an array ref. |
values may be defined and end up as an array ref. |
|
Line 6769 sub get_env_multiple {
|
Line 6958 sub get_env_multiple {
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item * upfile_store($r) |
=item * &upfile_store($r) |
| |
|
| Store uploaded file, $r should be the HTTP Request object, |
Store uploaded file, $r should be the HTTP Request object, |
| needs $env{'form.upfile'} |
needs $env{'form.upfile'} |
|
Line 6799 sub upfile_store {
|
Line 6988 sub upfile_store {
|
| |
|
| =pod |
=pod |
| |
|
| =item * load_tmp_file($r) |
=item * &load_tmp_file($r) |
| |
|
| Load uploaded file from tmp, $r should be the HTTP Request object, |
Load uploaded file from tmp, $r should be the HTTP Request object, |
| needs $env{'form.datatoken'}, |
needs $env{'form.datatoken'}, |
|
Line 6823 sub load_tmp_file {
|
Line 7012 sub load_tmp_file {
|
| |
|
| =pod |
=pod |
| |
|
| =item * upfile_record_sep() |
=item * &upfile_record_sep() |
| |
|
| Separate uploaded file into records |
Separate uploaded file into records |
| returns array of records, |
returns array of records, |
|
Line 6845 sub upfile_record_sep {
|
Line 7034 sub upfile_record_sep {
|
| |
|
| =pod |
=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'} |
Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'} |
| |
|
|
Line 6930 sub record_sep {
|
Line 7119 sub record_sep {
|
| |
|
| =pod |
=pod |
| |
|
| =item * upfile_select_html() |
=item * &upfile_select_html() |
| |
|
| Return HTML code to select a file from the users machine and specify |
Return HTML code to select a file from the users machine and specify |
| the file type. |
the file type. |
|
Line 6977 sub get_samples {
|
Line 7166 sub get_samples {
|
| |
|
| =pod |
=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 |
Prints a table of sample values from each column uploaded $r is an |
| Apache Request ref, $records is an arrayref from |
Apache Request ref, $records is an arrayref from |
|
Line 7013 sub csv_print_samples {
|
Line 7202 sub csv_print_samples {
|
| |
|
| =pod |
=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. |
Prints a table to create associations between values and table columns. |
| |
|
|
Line 7059 sub csv_print_select_table {
|
Line 7248 sub csv_print_select_table {
|
| |
|
| =pod |
=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. |
Prints a table of sample values from the upload and can make associate samples to internal names. |
| |
|
|
Line 7109 sub csv_samples_select_table {
|
Line 7298 sub csv_samples_select_table {
|
| |
|
| =pod |
=pod |
| |
|
| =item clean_excel_name($name) |
=item * &clean_excel_name($name) |
| |
|
| Returns a replacement for $name which does not contain any illegal characters. |
Returns a replacement for $name which does not contain any illegal characters. |
| |
|
|
Line 7128 sub clean_excel_name {
|
Line 7317 sub clean_excel_name {
|
| |
|
| =pod |
=pod |
| |
|
| =item * check_if_partid_hidden($id,$symb,$udom,$uname) |
=item * &check_if_partid_hidden($id,$symb,$udom,$uname) |
| |
|
| Returns either 1 or undef |
Returns either 1 or undef |
| |
|
|
Line 7169 sub check_if_partid_hidden {
|
Line 7358 sub check_if_partid_hidden {
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item get_cgi_id |
=item * &get_cgi_id() |
| |
|
| Inputs: none |
Inputs: none |
| |
|
|
Line 7193 sub get_cgi_id {
|
Line 7382 sub get_cgi_id {
|
| |
|
| =pod |
=pod |
| |
|
| =item DrawBarGraph |
=item * &DrawBarGraph() |
| |
|
| Facilitates the plotting of data in a (stacked) bar graph. |
Facilitates the plotting of data in a (stacked) bar graph. |
| Puts plot definition data into the users environment in order for |
Puts plot definition data into the users environment in order for |
|
Line 7328 sub DrawBarGraph {
|
Line 7517 sub DrawBarGraph {
|
| $ValuesHash{$id.'.'.$key} = $value; |
$ValuesHash{$id.'.'.$key} = $value; |
| } |
} |
| # |
# |
| &Apache::lonnet::appenv(%ValuesHash); |
&Apache::lonnet::appenv(\%ValuesHash); |
| return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />'; |
return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />'; |
| } |
} |
| |
|
|
Line 7337 sub DrawBarGraph {
|
Line 7526 sub DrawBarGraph {
|
| |
|
| =pod |
=pod |
| |
|
| =item DrawXYGraph |
=item * &DrawXYGraph() |
| |
|
| Facilitates the plotting of data in an XY graph. |
Facilitates the plotting of data in an XY graph. |
| Puts plot definition data into the users environment in order for |
Puts plot definition data into the users environment in order for |
|
Line 7418 sub DrawXYGraph {
|
Line 7607 sub DrawXYGraph {
|
| $ValuesHash{$id.'.'.$key} = $value; |
$ValuesHash{$id.'.'.$key} = $value; |
| } |
} |
| # |
# |
| &Apache::lonnet::appenv(%ValuesHash); |
&Apache::lonnet::appenv(\%ValuesHash); |
| return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />'; |
return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />'; |
| } |
} |
| |
|
|
Line 7427 sub DrawXYGraph {
|
Line 7616 sub DrawXYGraph {
|
| |
|
| =pod |
=pod |
| |
|
| =item DrawXYYGraph |
=item * &DrawXYYGraph() |
| |
|
| Facilitates the plotting of data in an XY graph with two Y axes. |
Facilitates the plotting of data in an XY graph with two Y axes. |
| Puts plot definition data into the users environment in order for |
Puts plot definition data into the users environment in order for |
|
Line 7520 sub DrawXYYGraph {
|
Line 7709 sub DrawXYYGraph {
|
| $ValuesHash{$id.'.'.$key} = $value; |
$ValuesHash{$id.'.'.$key} = $value; |
| } |
} |
| # |
# |
| &Apache::lonnet::appenv(%ValuesHash); |
&Apache::lonnet::appenv(\%ValuesHash); |
| return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />'; |
return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />'; |
| } |
} |
| |
|
|
Line 7537 Bad place for them but what the hell.
|
Line 7726 Bad place for them but what the hell.
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item &chartlink |
=item * &chartlink() |
| |
|
| Returns a link to the chart for a specific student. |
Returns a link to the chart for a specific student. |
| |
|
|
Line 7576 sub chartlink {
|
Line 7765 sub chartlink {
|
| |
|
| =over 4 |
=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. |
Restores/Store indicated form parameters from the course environment. |
| Will not overwrite existing values of the form parameters. |
Will not overwrite existing values of the form parameters. |
|
Line 7598 a hash ref describing the data to be sto
|
Line 7787 a hash ref describing the data to be sto
|
| |
|
| Returns: both routines return nothing |
Returns: both routines return nothing |
| |
|
| |
=back |
| |
|
| =cut |
=cut |
| |
|
| ####################################################### |
####################################################### |
|
Line 7650 sub store_settings {
|
Line 7841 sub store_settings {
|
| 'got error:'.$put_result); |
'got error:'.$put_result); |
| } |
} |
| # Make sure these settings stick around in this session, too |
# Make sure these settings stick around in this session, too |
| &Apache::lonnet::appenv(%AppHash); |
&Apache::lonnet::appenv(\%AppHash); |
| return; |
return; |
| } |
} |
| |
|
|
Line 7687 sub restore_settings {
|
Line 7878 sub restore_settings {
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item &build_recipient_list |
=item * &build_recipient_list() |
| |
|
| Build recipient lists for three types of e-mail: |
Build recipient lists for three types of e-mail: |
| (a) Error Reports, (b) Package Updates, (c) Help requests, generated by |
(a) Error Reports, (b) Package Updates, (c) Help requests, generated by |
|
Line 7753 sub build_recipient_list {
|
Line 7944 sub build_recipient_list {
|
| |
|
| sub commit_customrole { |
sub commit_customrole { |
| my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_; |
my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_; |
| my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.'@'.$three.' in '.$url. |
my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url. |
| ($start?', '.&mt('starting').' '.localtime($start):''). |
($start?', '.&mt('starting').' '.localtime($start):''). |
| ($end?', ending '.localtime($end):'').': <b>'. |
($end?', ending '.localtime($end):'').': <b>'. |
| &Apache::lonnet::assigncustomrole( |
&Apache::lonnet::assigncustomrole( |
|
Line 7816 sub commit_studentrole {
|
Line 8007 sub commit_studentrole {
|
| my $secchange = 0; |
my $secchange = 0; |
| my $expire_role_result; |
my $expire_role_result; |
| my $modify_section_result; |
my $modify_section_result; |
| unless ($oldsec eq '-1') { |
if ($oldsec ne '-1') { |
| unless ($sec eq $oldsec) { |
if ($oldsec ne $sec) { |
| $secchange = 1; |
$secchange = 1; |
| |
my $now = time; |
| my $uurl='/'.$cid; |
my $uurl='/'.$cid; |
| $uurl=~s/\_/\//g; |
$uurl=~s/\_/\//g; |
| if ($oldsec) { |
if ($oldsec) { |
| $uurl.='/'.$oldsec; |
$uurl.='/'.$oldsec; |
| } |
} |
| $oldsecurl = $uurl; |
$oldsecurl = $uurl; |
| $expire_role_result = &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',time); |
$expire_role_result = |
| |
&Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now); |
| |
if ($env{'request.course.sec'} ne '') { |
| |
if ($expire_role_result eq 'refused') { |
| |
my @roles = ('st'); |
| |
my @statuses = ('previous'); |
| |
my @roledoms = ($one); |
| |
my $withsec = 1; |
| |
my %roleshash = |
| |
&Apache::lonnet::get_my_roles($uname,$udom,'userroles', |
| |
\@statuses,\@roles,\@roledoms,$withsec); |
| |
if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) { |
| |
my ($oldstart,$oldend) = |
| |
split(':',$roleshash{$two.':'.$one.':st:'.$oldsec}); |
| |
if ($oldend > 0 && $oldend <= $now) { |
| |
$expire_role_result = 'ok'; |
| |
} |
| |
} |
| |
} |
| |
} |
| $result = $expire_role_result; |
$result = $expire_role_result; |
| } |
} |
| } |
} |
|
Line 7833 sub commit_studentrole {
|
Line 8044 sub commit_studentrole {
|
| $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid); |
$modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid); |
| if ($modify_section_result =~ /^ok/) { |
if ($modify_section_result =~ /^ok/) { |
| if ($secchange == 1) { |
if ($secchange == 1) { |
| $$logmsg .= &mt('Section for [_1] switched from old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed; |
if ($sec eq '') { |
| |
$$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed; |
| |
} else { |
| |
$$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed; |
| |
} |
| } elsif ($oldsec eq '-1') { |
} elsif ($oldsec eq '-1') { |
| $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed; |
if ($sec eq '') { |
| |
$$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed; |
| |
} else { |
| |
$$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed; |
| |
} |
| } else { |
} else { |
| $$logmsg .= &mt('Student [_1] assigned to unchanged section [_2] in course [_3].',$uname,$sec,$cid).$linefeed; |
if ($sec eq '') { |
| |
$$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed; |
| |
} else { |
| |
$$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed; |
| |
} |
| } |
} |
| } else { |
} else { |
| $$logmsg .= &mt('Error when attempting section change for [_1] from old section [_2] to new section: [_3] in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed; |
if ($secchange) { |
| |
$$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed; |
| |
} else { |
| |
$$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed; |
| |
} |
| } |
} |
| $result = $modify_section_result; |
$result = $modify_section_result; |
| } elsif ($secchange == 1) { |
} elsif ($secchange == 1) { |
| $$logmsg .= &mt('Error when attempting to expire role for [_1] in old section [_2] in course [_3] -error: ',$uname,$oldsec,$cid).' '.$expire_role_result.$linefeed; |
if ($oldsec eq '') { |
| |
$$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed; |
| |
} else { |
| |
$$logmsg .= &mt('Error when attempting to expire existing role for [_1] in section [_2] in course [_3] -error: ',$uname,$oldsec,$cid).' '.$expire_role_result.$linefeed; |
| |
} |
| if ($expire_role_result eq 'refused') { |
if ($expire_role_result eq 'refused') { |
| my $newsecurl = '/'.$cid; |
my $newsecurl = '/'.$cid; |
| $newsecurl =~ s/\_/\//g; |
$newsecurl =~ s/\_/\//g; |
|
Line 7973 sub construct_course {
|
Line 8204 sub construct_course {
|
| $outcome .= $clonemsg.$linefeed; |
$outcome .= $clonemsg.$linefeed; |
| my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); |
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); |
| # Copy all files |
# Copy all files |
| &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid); |
&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'}); |
| # Restore URL |
# Restore URL |
| $cenv{'url'}=$oldcenv{'url'}; |
$cenv{'url'}=$oldcenv{'url'}; |
| # Restore title |
# Restore title |
| $cenv{'description'}=$oldcenv{'description'}; |
$cenv{'description'}=$oldcenv{'description'}; |
| # restore grading mode |
|
| if (defined($oldcenv{'grading'})) { |
|
| $cenv{'grading'}=$oldcenv{'grading'}; |
|
| } |
|
| # Mark as cloned |
# Mark as cloned |
| $cenv{'clonedfrom'}=$cloneid; |
$cenv{'clonedfrom'}=$cloneid; |
| delete($cenv{'default_enrollment_start_date'}); |
# Need to clone grading mode |
| delete($cenv{'default_enrollment_end_date'}); |
my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum); |
| |
$cenv{'grading'}=$newenv{'grading'}; |
| |
# Do not clone these environment entries |
| |
&Apache::lonnet::del('environment', |
| |
['default_enrollment_start_date', |
| |
'default_enrollment_end_date', |
| |
'question.email', |
| |
'policy.email', |
| |
'comment.email', |
| |
'pch.users.denied', |
| |
'plc.users.denied'], |
| |
$$crsudom,$$crsunum); |
| } |
} |
| |
|
| # |
# |
|
Line 8013 sub construct_course {
|
Line 8251 sub construct_course {
|
| } else { |
} else { |
| $cenv{'internal.courseowner'} = $args->{'curruser'}; |
$cenv{'internal.courseowner'} = $args->{'curruser'}; |
| } |
} |
| |
|
| my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner. |
my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner. |
| if ($args->{'crssections'}) { |
if ($args->{'crssections'}) { |
| $cenv{'internal.sectionnums'} = ''; |
$cenv{'internal.sectionnums'} = ''; |
|
Line 8073 sub construct_course {
|
Line 8310 sub construct_course {
|
| } |
} |
| if ($args->{'notify_dc'}) { |
if ($args->{'notify_dc'}) { |
| if ($uname ne '') { |
if ($uname ne '') { |
| push(@notified,$uname.'@'.$udom); |
push(@notified,$uname.':'.$udom); |
| } |
} |
| } |
} |
| if (@notified > 0) { |
if (@notified > 0) { |
![[BACK]](/icons/back.gif){kind=icon}
Return to loncommon.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface