version 1.617, 2007/12/01 03:42:47
|
version 1.648, 2008/03/23 21:40:10
|
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 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 1942 sub authform_kerberos {
|
Line 2009 sub authform_kerberos {
|
if (defined($in{'curr_authtype'})) { |
if (defined($in{'curr_authtype'})) { |
if ($in{'curr_authtype'} eq 'krb') { |
if ($in{'curr_authtype'} eq 'krb') { |
$krbcheck = ' checked="on"'; |
$krbcheck = ' checked="on"'; |
|
if (defined($in{'mode'})) { |
|
if ($in{'mode'} eq 'modifyuser') { |
|
$krbcheck = ''; |
|
} |
|
} |
if (defined($in{'curr_kerb_ver'})) { |
if (defined($in{'curr_kerb_ver'})) { |
if ($in{'curr_krb_ver'} eq '5') { |
if ($in{'curr_krb_ver'} eq '5') { |
$check5 = ' checked="on"'; |
$check5 = ' checked="on"'; |
Line 2039 sub authform_internal{
|
Line 2111 sub authform_internal{
|
if ($in{'curr_authtype'} eq 'int') { |
if ($in{'curr_authtype'} eq 'int') { |
if ($can_assign{'int'}) { |
if ($can_assign{'int'}) { |
$intcheck = 'checked="on" '; |
$intcheck = 'checked="on" '; |
|
if (defined($in{'mode'})) { |
|
if ($in{'mode'} eq 'modifyuser') { |
|
$intcheck = ''; |
|
} |
|
} |
if (defined($in{'curr_autharg'})) { |
if (defined($in{'curr_autharg'})) { |
$intarg = $in{'curr_autharg'}; |
$intarg = $in{'curr_autharg'}; |
} |
} |
Line 2073 sub authform_internal{
|
Line 2150 sub authform_internal{
|
$result = &mt |
$result = &mt |
('[_1] Internally authenticated (with initial password [_2])', |
('[_1] Internally authenticated (with initial password [_2])', |
'<label>'.$authtype,'</label>'.$autharg); |
'<label>'.$authtype,'</label>'.$autharg); |
|
$result.="<label><input type=\"checkbox\" name=\"visible\" onClick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>'; |
return $result; |
return $result; |
} |
} |
|
|
Line 2088 sub authform_local{
|
Line 2166 sub authform_local{
|
if ($in{'curr_authtype'} eq 'loc') { |
if ($in{'curr_authtype'} eq 'loc') { |
if ($can_assign{'loc'}) { |
if ($can_assign{'loc'}) { |
$loccheck = 'checked="on" '; |
$loccheck = 'checked="on" '; |
|
if (defined($in{'mode'})) { |
|
if ($in{'mode'} eq 'modifyuser') { |
|
$loccheck = ''; |
|
} |
|
} |
if (defined($in{'curr_autharg'})) { |
if (defined($in{'curr_autharg'})) { |
$locarg = $in{'curr_autharg'}; |
$locarg = $in{'curr_autharg'}; |
} |
} |
Line 2137 sub authform_filesystem{
|
Line 2220 sub authform_filesystem{
|
if ($in{'curr_authtype'} eq 'fsys') { |
if ($in{'curr_authtype'} eq 'fsys') { |
if ($can_assign{'fsys'}) { |
if ($can_assign{'fsys'}) { |
$fsyscheck = 'checked="on" '; |
$fsyscheck = 'checked="on" '; |
|
if (defined($in{'mode'})) { |
|
if ($in{'mode'} eq 'modifyuser') { |
|
$fsyscheck = ''; |
|
} |
|
} |
} else { |
} else { |
$result = &mt('Currently Filesystem Authenticated.'); |
$result = &mt('Currently Filesystem Authenticated.'); |
return $result; |
return $result; |
Line 2218 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 2265 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 2289 sub get_kerberos_defaults {
|
Line 2350 sub get_kerberos_defaults {
|
return ($krbdef,$krbdefdom); |
return ($krbdef,$krbdefdom); |
} |
} |
|
|
=pod |
|
|
|
=back |
|
|
|
=cut |
|
|
|
############################################################### |
############################################################### |
## Thesaurus Functions ## |
## Thesaurus Functions ## |
Line 2305 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 2350 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 2371 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 2429 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 2458 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 2508 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 2554 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 2650 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 2662 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 2687 sub supportedlanguagecode {
|
Line 2746 sub supportedlanguagecode {
|
|
|
=pod |
=pod |
|
|
=item * copyrightids() |
=item * ©rightids() |
|
|
returns list of all copyrights |
returns list of all copyrights |
|
|
Line 2699 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 2711 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 2723 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 2735 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 2747 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 2761 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 2785 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 2799 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 2859 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 2923 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 3067 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 3100 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 3646 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 3734 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 3756 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 3924 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 3947 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 4073 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 4347 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 4433 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 4708 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 4922 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 5038 div.LC_clear_float_footer {
|
Line 5149 div.LC_clear_float_footer {
|
|
|
|
|
div.LC_grade_select_mode { |
div.LC_grade_select_mode { |
float: left; |
|
font-family: $sans; |
font-family: $sans; |
} |
} |
div.LC_grade_select_mode div div { |
div.LC_grade_select_mode div div { |
Line 5248 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 5310 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 5326 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 5450 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 5828 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 5844 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 5920 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 5953 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 6147 sub default_quota {
|
Line 6290 sub default_quota {
|
my ($udom,$inststatus) = @_; |
my ($udom,$inststatus) = @_; |
my ($defquota,$settingstatus); |
my ($defquota,$settingstatus); |
my %quotahash = &Apache::lonnet::get_dom('configuration', |
my %quotahash = &Apache::lonnet::get_dom('configuration', |
['quota'],$udom); |
['quotas'],$udom); |
if (ref($quotahash{'quota'}) eq 'HASH') { |
if (ref($quotahash{'quotas'}) eq 'HASH') { |
if ($inststatus ne '') { |
if ($inststatus ne '') { |
my @statuses = split(/:/,$inststatus); |
my @statuses = split(/:/,$inststatus); |
foreach my $item (@statuses) { |
foreach my $item (@statuses) { |
if ($quotahash{'quota'}{$item} ne '') { |
if ($quotahash{'quotas'}{$item} ne '') { |
if ($defquota eq '') { |
if ($defquota eq '') { |
$defquota = $quotahash{'quota'}{$item}; |
$defquota = $quotahash{'quotas'}{$item}; |
$settingstatus = $item; |
$settingstatus = $item; |
} elsif ($quotahash{'quota'}{$item} > $defquota) { |
} elsif ($quotahash{'quotas'}{$item} > $defquota) { |
$defquota = $quotahash{'quota'}{$item}; |
$defquota = $quotahash{'quotas'}{$item}; |
$settingstatus = $item; |
$settingstatus = $item; |
} |
} |
} |
} |
} |
} |
} |
} |
if ($defquota eq '') { |
if ($defquota eq '') { |
$defquota = $quotahash{'quota'}{'default'}; |
$defquota = $quotahash{'quotas'}{'default'}; |
$settingstatus = 'default'; |
$settingstatus = 'default'; |
} |
} |
} else { |
} else { |
Line 6216 sub get_secgrprole_info {
|
Line 6359 sub get_secgrprole_info {
|
} |
} |
|
|
sub user_picker { |
sub user_picker { |
my ($dom,$srch,$forcenewuser,$caller) = @_; |
my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_; |
my $currdom = $dom; |
my $currdom = $dom; |
my %curr_selected = ( |
my %curr_selected = ( |
srchin => 'dom', |
srchin => 'dom', |
srchby => 'lastname', |
srchby => 'lastname', |
); |
); |
my $srchterm; |
my $srchterm; |
if (ref($srch) eq 'HASH') { |
if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) { |
if ($srch->{'srchby'} ne '') { |
if ($srch->{'srchby'} ne '') { |
$curr_selected{'srchby'} = $srch->{'srchby'}; |
$curr_selected{'srchby'} = $srch->{'srchby'}; |
} |
} |
Line 6310 sub user_picker {
|
Line 6453 sub user_picker {
|
if ($forcenewuser) { |
if ($forcenewuser) { |
if (ref($srch) eq 'HASH') { |
if (ref($srch) eq 'HASH') { |
if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) { |
if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) { |
$new_user_create = '<p> <input type="submit" name="forcenew" value="'.&HTML::Entities::encode(&mt('Make new user "[_1]"',$srchterm),'<>&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> </p>'; |
if ($cancreate) { |
|
$new_user_create = '<p> <input type="submit" name="forcenew" value="'.&HTML::Entities::encode(&mt('Make new user "[_1]"',$srchterm),'<>&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> </p>'; |
|
} else { |
|
my $helplink = ' href="javascript:helpMenu('."'display'".')"'; |
|
my %usertypetext = ( |
|
official => 'institutional', |
|
unofficial => 'non-institutional', |
|
); |
|
$new_user_create = '<br /><span class="LC_warning">'.&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.").' '.&mt('Contact the <a[_1]>helpdesk</a> for assistance.',$helplink).'</span><br /><br />'; |
|
} |
} |
} |
} |
} |
|
|
Line 6578 sub instrule_disallow_msg {
|
Line 6730 sub instrule_disallow_msg {
|
return $response; |
return $response; |
} |
} |
|
|
|
sub personal_data_fieldtitles { |
|
my %fieldtitles = &Apache::lonlocal::texthash ( |
|
id => 'Student/Employee ID', |
|
permanentemail => 'E-mail address', |
|
lastname => 'Last Name', |
|
firstname => 'First Name', |
|
middlename => 'Middle Name', |
|
generation => 'Generation', |
|
gen => 'Generation', |
|
); |
|
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 6586 sub instrule_disallow_msg {
|
Line 6817 sub instrule_disallow_msg {
|
|
|
=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 6615 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 6632 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 6668 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 6695 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 6727 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 6757 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 6781 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 6803 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 6888 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 6935 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 6971 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 7017 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 7067 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 7086 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 7127 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 7151 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 7286 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 7295 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 7376 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 7385 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 7478 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 7495 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 7534 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 7556 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 7608 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 7636 sub restore_settings {
|
Line 7869 sub restore_settings {
|
} |
} |
} |
} |
|
|
|
####################################################### |
|
####################################################### |
|
|
|
=pod |
|
|
|
=head1 Domain E-mail Routines |
|
|
|
=over 4 |
|
|
|
=item * &build_recipient_list() |
|
|
|
Build recipient lists for three types of e-mail: |
|
(a) Error Reports, (b) Package Updates, (c) Help requests, generated by |
|
lonerrorhandler.pm, CHECKRPMS and lonsupportreq.pm respectively. |
|
|
|
Inputs: |
|
defmail (scalar - email address of default recipient), |
|
mailing type (scalar - errormail, packagesmail, or helpdeskmail), |
|
defdom (domain for which to retrieve configuration settings), |
|
origmail (scalar - email address of recipient from loncapa.conf, |
|
i.e., predates configuration by DC via domainprefs.pm |
|
|
|
Returns: comma separated list of addresses to which to send e-mail. |
|
|
|
=cut |
|
|
|
############################################################ |
|
############################################################ |
|
sub build_recipient_list { |
|
my ($defmail,$mailing,$defdom,$origmail) = @_; |
|
my @recipients; |
|
my $otheremails; |
|
my %domconfig = |
|
&Apache::lonnet::get_dom('configuration',['contacts'],$defdom); |
|
if (ref($domconfig{'contacts'}) eq 'HASH') { |
|
if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') { |
|
my @contacts = ('adminemail','supportemail'); |
|
foreach my $item (@contacts) { |
|
if ($domconfig{'contacts'}{$mailing}{$item}) { |
|
my $addr = $domconfig{'contacts'}{$item}; |
|
if (!grep(/^\Q$addr\E$/,@recipients)) { |
|
push(@recipients,$addr); |
|
} |
|
} |
|
$otheremails = $domconfig{'contacts'}{$mailing}{'others'}; |
|
} |
|
} |
|
} elsif ($origmail ne '') { |
|
push(@recipients,$origmail); |
|
} |
|
if ($defmail ne '') { |
|
push(@recipients,$defmail); |
|
} |
|
if ($otheremails) { |
|
my @others; |
|
if ($otheremails =~ /,/) { |
|
@others = split(/,/,$otheremails); |
|
} else { |
|
push(@others,$otheremails); |
|
} |
|
foreach my $addr (@others) { |
|
if (!grep(/^\Q$addr\E$/,@recipients)) { |
|
push(@recipients,$addr); |
|
} |
|
} |
|
} |
|
my $recipientlist = join(',',@recipients); |
|
return $recipientlist; |
|
} |
|
|
############################################################ |
############################################################ |
############################################################ |
############################################################ |
|
|
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 7662 sub commit_standardrole {
|
Line 7965 sub commit_standardrole {
|
my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end, |
my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end, |
$one,$two,$sec,$context); |
$one,$two,$sec,$context); |
if (($result =~ /^error/) || ($result eq 'not_in_class') || |
if (($result =~ /^error/) || ($result eq 'not_in_class') || |
($result eq 'unknown_course')) { |
($result eq 'unknown_course') || ($result eq 'refused')) { |
$output = "Error: $result\n"; |
$output = $logmsg.' '.&mt('Error: ').$result."\n"; |
} else { |
} else { |
$output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url. |
$output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url. |
($start?', '.&mt('starting').' '.localtime($start):''). |
($start?', '.&mt('starting').' '.localtime($start):''). |
Line 7692 sub commit_standardrole {
|
Line 7995 sub commit_standardrole {
|
|
|
sub commit_studentrole { |
sub commit_studentrole { |
my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_; |
my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_; |
my ($result,$linefeed); |
my ($result,$linefeed,$oldsecurl,$newsecurl); |
if ($context eq 'auto') { |
if ($context eq 'auto') { |
$linefeed = "\n"; |
$linefeed = "\n"; |
} else { |
} else { |
Line 7704 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; |
} |
} |
$expire_role_result = &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',time); |
$oldsecurl = $uurl; |
|
$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 7720 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 .= "Section for $uname switched from old section: $oldsec to new section: $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 .= "New student role for $uname in section $sec in course $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 .= "Student $uname assigned to unchanged section $sec in course $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 .= "Error when attempting section change for $uname from old section $oldsec to new section: $sec in course $cid -error: $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 .= "Error when attempting to expire role for $uname in old section $oldsec in course $cid -error: $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') { |
|
my $newsecurl = '/'.$cid; |
|
$newsecurl =~ s/\_/\//g; |
|
if ($sec ne '') { |
|
$newsecurl.='/'.$sec; |
|
} |
|
if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) { |
|
if ($sec eq '') { |
|
$$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments unaffiliated with any section.',$sec).$linefeed; |
|
} else { |
|
$$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments in other sections.',$sec).$linefeed; |
|
} |
|
} |
|
} |
} |
} |
} else { |
} else { |
$$logmsg .= "Incomplete course id defined. Addition of user $uname from domain $udom to course $one\_$two, section $sec not completed.$linefeed"; |
$$logmsg .= &mt('Incomplete course id defined.').$linefeed.&mt('Addition of user [_1] from domain [_2] to course [_3], section [_4] not completed.',$uname,$udom,$one.'_'.$two,$sec).$linefeed; |
$result = "error: incomplete course id\n"; |
$result = "error: incomplete course id\n"; |
} |
} |
return $result; |
return $result; |
Line 7846 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 7886 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 7946 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) { |