|
version 1.636.2.3, 2008/03/18 23:00:51
|
version 1.664, 2008/07/06 05:01:52
|
|
Line 67 use Apache::loncoursedata();
|
Line 67 use Apache::loncoursedata();
|
| use Apache::lontexconvert(); |
use Apache::lontexconvert(); |
| use Apache::lonclonecourse(); |
use Apache::lonclonecourse(); |
| use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
| |
use DateTime::TimeZone; |
| |
|
| # ---------------------------------------------- Designs |
# ---------------------------------------------- Designs |
| use vars qw(%defaultdesign); |
use vars qw(%defaultdesign); |
|
Line 78 my $readit;
|
Line 79 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; |
| |
if (!$ok) { |
| |
&Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message); |
| |
} |
| |
$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 285 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 305 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 390 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 377 sub selectstudent_link {
|
Line 448 sub selectstudent_link {
|
| return ''; |
return ''; |
| } |
} |
| |
|
| |
sub authorbrowser_javascript { |
| |
return <<"ENDAUTHORBRW"; |
| |
<script type="text/javascript"> |
| |
var stdeditbrowser; |
| |
|
| |
function openauthorbrowser(formname,udom) { |
| |
var url = '/adm/pickauthor?'; |
| |
url += 'form='+formname+'&roledom='+udom; |
| |
var title = 'Author_Browser'; |
| |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
| |
options += ',width=700,height=600'; |
| |
stdeditbrowser = open(url,title,options,'1'); |
| |
stdeditbrowser.focus(); |
| |
} |
| |
|
| |
</script> |
| |
ENDAUTHORBRW |
| |
} |
| |
|
| sub coursebrowser_javascript { |
sub coursebrowser_javascript { |
| my ($domainfilter,$sec_element,$formname)=@_; |
my ($domainfilter,$sec_element,$formname)=@_; |
| my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role'); |
my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role'); |
|
Line 514 sub selectcourse_link {
|
Line 604 sub selectcourse_link {
|
| '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course')."</a>"; |
'","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course')."</a>"; |
| } |
} |
| |
|
| |
sub selectauthor_link { |
| |
my ($form,$udom)=@_; |
| |
return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'. |
| |
&mt('Select Author').'</a>'; |
| |
} |
| |
|
| sub check_uncheck_jscript { |
sub check_uncheck_jscript { |
| my $jscript = <<"ENDSCRT"; |
my $jscript = <<"ENDSCRT"; |
| function checkAll(field) { |
function checkAll(field) { |
|
Line 539 ENDSCRT
|
Line 635 ENDSCRT
|
| return $jscript; |
return $jscript; |
| } |
} |
| |
|
| |
sub select_timezone { |
| |
my ($name,$selected,$onchange,$includeempty)=@_; |
| |
my $output='<select name="'.$name.'" '.$onchange.'>'."\n"; |
| |
if ($includeempty) { |
| |
$output .= '<option value=""'; |
| |
if (($selected eq '') || ($selected eq 'local')) { |
| |
$output .= ' selected="selected" '; |
| |
} |
| |
$output .= '> </option>'; |
| |
} |
| |
my @timezones = DateTime::TimeZone->all_names; |
| |
foreach my $tzone (@timezones) { |
| |
$output.= '<option value="'.$tzone.'"'; |
| |
if ($tzone eq $selected) { |
| |
$output.=' selected="selected"'; |
| |
} |
| |
$output.=">$tzone</option>\n"; |
| |
} |
| |
$output.="</select>"; |
| |
return $output; |
| |
} |
| |
|
| =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 707 END
|
Line 824 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 761 sub help_open_topic {
|
Line 878 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 1017 ENDTEMPLATE
|
Line 1134 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 1072 DOMBASED
|
Line 1189 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 1096 sub changable_area {
|
Line 1213 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 1143 GEOMETRY
|
Line 1260 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 1167 DIMS
|
Line 1284 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 1176 the id of the element to resize, second
|
Line 1293 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 1228 RESIZE
|
Line 1346 RESIZE
|
| |
|
| =pod |
=pod |
| |
|
| =back |
|
| |
|
| =head1 Excel and CSV file utility routines |
=head1 Excel and CSV file utility routines |
| |
|
| =over 4 |
=over 4 |
|
Line 1241 RESIZE
|
Line 1357 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 1262 sub csv_translate {
|
Line 1378 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 1318 sub define_excel_formats {
|
Line 1434 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 1361 sub create_workbook {
|
Line 1477 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 1429 sub domain_select {
|
Line 1545 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 1479 sub multiple_select_form {
|
Line 1595 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 1566 sub select_level_form {
|
Line 1682 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 1606 sub select_dom_form {
|
Line 1722 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 1766 sub decode_user_agent {
|
Line 1882 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 1790 See loncreateuser.pm for invocation and
|
Line 1904 See loncreateuser.pm for invocation and
|
| |
|
| =back |
=back |
| |
|
| =back |
See loncreateuser.pm for invocation and use examples. |
| |
|
| =cut |
=cut |
| |
|
|
Line 2242 sub get_assignable_auth {
|
Line 2356 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 2289 sub get_auth_defaults {
|
Line 2367 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 2313 sub get_kerberos_defaults {
|
Line 2400 sub get_kerberos_defaults {
|
| return ($krbdef,$krbdefdom); |
return ($krbdef,$krbdefdom); |
| } |
} |
| |
|
| =pod |
|
| |
|
| =back |
|
| |
|
| =cut |
|
| |
|
| ############################################################### |
############################################################### |
| ## Thesaurus Functions ## |
## Thesaurus Functions ## |
|
Line 2329 sub get_kerberos_defaults {
|
Line 2411 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 2374 sub initialize_keywords {
|
Line 2456 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 2395 sub keyword {
|
Line 2477 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 2453 sub get_related_words {
|
Line 2535 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 2482 sub plainname {
|
Line 2564 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 2532 sub getnames {
|
Line 2614 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 2578 sub flush_email_cache {
|
Line 2663 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 2674 sub student_image_tag {
|
Line 2759 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 2686 sub languageids {
|
Line 2771 sub languageids {
|
| |
|
| =pod |
=pod |
| |
|
| =item * languagedescription() |
=item * &languagedescription() |
| |
|
| returns description of a specified language id |
returns description of a specified language id |
| |
|
|
Line 2711 sub supportedlanguagecode {
|
Line 2796 sub supportedlanguagecode {
|
| |
|
| =pod |
=pod |
| |
|
| =item * copyrightids() |
=item * ©rightids() |
| |
|
| returns list of all copyrights |
returns list of all copyrights |
| |
|
|
Line 2723 sub copyrightids {
|
Line 2808 sub copyrightids {
|
| |
|
| =pod |
=pod |
| |
|
| =item * copyrightdescription() |
=item * ©rightdescription() |
| |
|
| returns description of a specified copyright id |
returns description of a specified copyright id |
| |
|
|
Line 2735 sub copyrightdescription {
|
Line 2820 sub copyrightdescription {
|
| |
|
| =pod |
=pod |
| |
|
| =item * source_copyrightids() |
=item * &source_copyrightids() |
| |
|
| returns list of all source copyrights |
returns list of all source copyrights |
| |
|
|
Line 2747 sub source_copyrightids {
|
Line 2832 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 2759 sub source_copyrightdescription {
|
Line 2844 sub source_copyrightdescription {
|
| |
|
| =pod |
=pod |
| |
|
| =item * filecategories() |
=item * &filecategories() |
| |
|
| returns list of all file categories |
returns list of all file categories |
| |
|
|
Line 2771 sub filecategories {
|
Line 2856 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 2785 sub filecategorytypes {
|
Line 2870 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 2809 sub filecategoryselect {
|
Line 2894 sub filecategoryselect {
|
| |
|
| =pod |
=pod |
| |
|
| =item * filedescription() |
=item * &filedescription() |
| |
|
| returns description for a specified file type |
returns description for a specified file type |
| |
|
|
Line 2823 sub filedescription {
|
Line 2908 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 2869 sub display_languages {
|
Line 2954 sub display_languages {
|
| |
|
| sub preferred_languages { |
sub preferred_languages { |
| my @languages=(); |
my @languages=(); |
| |
if (($env{'request.role.adv'}) && ($env{'form.languages'})) { |
| |
@languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$env{'form.languages'})); |
| |
} |
| if ($env{'course.'.$env{'request.course.id'}.'.languages'}) { |
if ($env{'course.'.$env{'request.course.id'}.'.languages'}) { |
| @languages=(@languages,split(/\s*(\,|\;|\:)\s*/, |
@languages=(@languages,split(/\s*(\,|\;|\:)\s*/, |
| $env{'course.'.$env{'request.course.id'}.'.languages'})); |
$env{'course.'.$env{'request.course.id'}.'.languages'})); |
| } |
} |
| |
|
| if ($env{'environment.languages'}) { |
if ($env{'environment.languages'}) { |
| @languages=(@languages, |
@languages=(@languages, |
| split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'})); |
split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'})); |
|
Line 2883 sub preferred_languages {
|
Line 2972 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 2947 sub languages {
|
Line 3030 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 3091 sub relative_to_absolute {
|
Line 3174 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 3110 sub get_student_view {
|
Line 3193 sub get_student_view {
|
| } |
} |
| if (defined($target)) { $form{'grade_target'} = $target; } |
if (defined($target)) { $form{'grade_target'} = $target; } |
| $feedurl=&Apache::lonnet::clutter($feedurl); |
$feedurl=&Apache::lonnet::clutter($feedurl); |
| my $userview=&Apache::lonnet::ssi_body($feedurl,%form); |
my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form); |
| $userview=~s/\<body[^\>]*\>//gi; |
$userview=~s/\<body[^\>]*\>//gi; |
| $userview=~s/\<\/body\>//gi; |
$userview=~s/\<\/body\>//gi; |
| $userview=~s/\<html\>//gi; |
$userview=~s/\<html\>//gi; |
|
Line 3119 sub get_student_view {
|
Line 3202 sub get_student_view {
|
| $userview=~s/\<\/head\>//gi; |
$userview=~s/\<\/head\>//gi; |
| $userview=~s/action\s*\=/would_be_action\=/gi; |
$userview=~s/action\s*\=/would_be_action\=/gi; |
| $userview=&relative_to_absolute($feedurl,$userview); |
$userview=&relative_to_absolute($feedurl,$userview); |
| return $userview; |
if (wantarray) { |
| |
return ($userview,$response); |
| |
} else { |
| |
return $userview; |
| |
} |
| |
} |
| |
|
| |
sub get_student_view_with_retries { |
| |
my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_; |
| |
|
| |
my $ok = 0; # True if we got a good response. |
| |
my $content; |
| |
my $response; |
| |
|
| |
# Try to get the student_view done. within the retries count: |
| |
|
| |
do { |
| |
($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv); |
| |
$ok = $response->is_success; |
| |
if (!$ok) { |
| |
&Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message); |
| |
} |
| |
$retries--; |
| |
} while (!$ok && ($retries > 0)); |
| |
|
| |
if (!$ok) { |
| |
$content = ''; # On error return an empty content. |
| |
} |
| |
if (wantarray) { |
| |
return ($content, $response); |
| |
} else { |
| |
return $content; |
| |
} |
| } |
} |
| |
|
| =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 3981 ENDROLE
|
Line 4096 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 4006 ENDROLE
|
Line 4121 ENDROLE
|
| $titleinfo = |
$titleinfo = |
| &Apache::loncommon::help_open_menu('','',3,'Authoring') |
&Apache::loncommon::help_open_menu('','',3,'Authoring') |
| .'<b>'.&mt('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()') |
| .'</form>' |
.'</form>' |
|
Line 4777 table.LC_pick_box td.LC_pick_box_title {
|
Line 4892 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 5321 Inputs: none
|
Line 5444 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 5383 sub endheadtag {
|
Line 5503 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 5399 sub head {
|
Line 5526 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 6692 sub personal_data_fieldtitles {
|
Line 6829 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 6700 sub personal_data_fieldtitles {
|
Line 6903 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 6729 sub get_unprocessed_cgi {
|
Line 6932 sub get_unprocessed_cgi {
|
| |
|
| =pod |
=pod |
| |
|
| =item * cacheheader() |
=item * &cacheheader() |
| |
|
| returns cache-controlling header code |
returns cache-controlling header code |
| |
|
|
Line 6746 sub cacheheader {
|
Line 6949 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 6782 sub content_type {
|
Line 6985 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 6809 sub add_to_env {
|
Line 7012 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 6832 sub get_env_multiple {
|
Line 7035 sub get_env_multiple {
|
| return(@values); |
return(@values); |
| } |
} |
| |
|
| |
sub ask_for_embedded_content { |
| |
my ($actionurl,$state,$allfiles,$codebase,$args)=@_; |
| |
my $upload_output = ' |
| |
<form name="upload_embedded" action="'.$actionurl.'" |
| |
method="post" enctype="multipart/form-data">'; |
| |
$upload_output .= $state; |
| |
$upload_output .= '<b>Upload embedded files</b>:<br />'.&start_data_table(); |
| |
|
| |
my $num = 0; |
| |
foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) { |
| |
$upload_output .= &start_data_table_row(). |
| |
'<td>'.$embed_file.'</td><td>'; |
| |
if ($args->{'ignore_remote_references'} |
| |
&& $embed_file =~ m{^\w+://}) { |
| |
$upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>'; |
| |
} elsif ($args->{'error_on_invalid_names'} |
| |
&& $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) { |
| |
|
| |
$upload_output.='<span class="LC_warning">'.&mt("Invalid characters").'</span>'; |
| |
|
| |
} else { |
| |
$upload_output .=' |
| |
<input name="embedded_item_'.$num.'" type="file" value="" /> |
| |
<input name="embedded_orig_'.$num.'" type="hidden" value="'.&escape($embed_file).'" />'; |
| |
my $attrib = join(':',@{$$allfiles{$embed_file}}); |
| |
$upload_output .= |
| |
"\n\t\t". |
| |
'<input name="embedded_attrib_'.$num.'" type="hidden" value="'. |
| |
$attrib.'" />'; |
| |
if (exists($$codebase{$embed_file})) { |
| |
$upload_output .= |
| |
"\n\t\t". |
| |
'<input name="codebase_'.$num.'" type="hidden" value="'. |
| |
&escape($$codebase{$embed_file}).'" />'; |
| |
} |
| |
} |
| |
$upload_output .= '</td>'.&Apache::loncommon::end_data_table_row(); |
| |
$num++; |
| |
} |
| |
$upload_output .= &Apache::loncommon::end_data_table().'<br /> |
| |
<input type ="hidden" name="number_embedded_items" value="'.$num.'" /> |
| |
<input type ="submit" value="'.&mt('Upload Listed Files').'" /> |
| |
'.&mt('(only files for which a location has been provided will be uploaded)').' |
| |
</form>'; |
| |
return $upload_output; |
| |
} |
| |
|
| |
sub upload_embedded { |
| |
my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota, |
| |
$current_disk_usage) = @_; |
| |
my $output; |
| |
for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) { |
| |
next if (!exists($env{'form.embedded_item_'.$i.'.filename'})); |
| |
my $orig_uploaded_filename = |
| |
$env{'form.embedded_item_'.$i.'.filename'}; |
| |
|
| |
$env{'form.embedded_orig_'.$i} = |
| |
&unescape($env{'form.embedded_orig_'.$i}); |
| |
my ($path,$fname) = |
| |
($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)}); |
| |
# no path, whole string is fname |
| |
if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} }; |
| |
|
| |
$path = $env{'form.currentpath'}.$path; |
| |
$fname = &Apache::lonnet::clean_filename($fname); |
| |
# See if there is anything left |
| |
next if ($fname eq ''); |
| |
|
| |
# Check if file already exists as a file or directory. |
| |
my ($state,$msg); |
| |
if ($context eq 'portfolio') { |
| |
my $port_path = $dirpath; |
| |
if ($group ne '') { |
| |
$port_path = "groups/$group/$port_path"; |
| |
} |
| |
($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i, |
| |
$dir_root,$port_path,$disk_quota, |
| |
$current_disk_usage,$uname,$udom); |
| |
if ($state eq 'will_exceed_quota' |
| |
|| $state eq 'file_locked' |
| |
|| $state eq 'file_exists' ) { |
| |
$output .= $msg; |
| |
next; |
| |
} |
| |
} elsif (($context eq 'author') || ($context eq 'testbank')) { |
| |
($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i); |
| |
if ($state eq 'exists') { |
| |
$output .= $msg; |
| |
next; |
| |
} |
| |
} |
| |
# Check if extension is valid |
| |
if (($fname =~ /\.(\w+)$/) && |
| |
(&Apache::loncommon::fileembstyle($1) eq 'hdn')) { |
| |
$output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1); |
| |
next; |
| |
} elsif (($fname =~ /\.(\w+)$/) && |
| |
(!defined(&Apache::loncommon::fileembstyle($1)))) { |
| |
$output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1); |
| |
next; |
| |
} elsif ($fname=~/\.(\d+)\.(\w+)$/) { |
| |
$output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2); |
| |
next; |
| |
} |
| |
|
| |
$env{'form.embedded_item_'.$i.'.filename'}=$fname; |
| |
if ($context eq 'portfolio') { |
| |
my $result= |
| |
&Apache::lonnet::userfileupload('embedded_item_'.$i,'', |
| |
$dirpath.$path); |
| |
if ($result !~ m|^/uploaded/|) { |
| |
$output .= '<span class="LC_error">' |
| |
.&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].' |
| |
,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}) |
| |
.'</span><br />'; |
| |
next; |
| |
} else { |
| |
$output .= '<p>'.&mt('Uploaded [_1]','<span class="LC_filename">'. |
| |
$path.$fname.'</span>').'</p>'; |
| |
} |
| |
} else { |
| |
# Save the file |
| |
my $target = $env{'form.embedded_item_'.$i}; |
| |
my $fullpath = $dir_root.$dirpath.'/'.$path; |
| |
my $dest = $fullpath.$fname; |
| |
my $url = $url_root.$dirpath.'/'.$path.$fname; |
| |
my @parts=split(/\//,$fullpath); |
| |
my $count; |
| |
my $filepath = $dir_root; |
| |
for ($count=4;$count<=$#parts;$count++) { |
| |
$filepath .= "/$parts[$count]"; |
| |
if ((-e $filepath)!=1) { |
| |
mkdir($filepath,0770); |
| |
} |
| |
} |
| |
my $fh; |
| |
if (!open($fh,'>'.$dest)) { |
| |
&Apache::lonnet::logthis('Failed to create '.$dest); |
| |
$output .= '<span class="LC_error">'. |
| |
&mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). |
| |
'</span><br />'; |
| |
} else { |
| |
if (!print $fh $env{'form.embedded_item_'.$i}) { |
| |
&Apache::lonnet::logthis('Failed to write to '.$dest); |
| |
$output .= '<span class="LC_error">'. |
| |
&mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). |
| |
'</span><br />'; |
| |
} else { |
| |
if ($context eq 'testbank') { |
| |
$output .= &mt('Embedded file uploaded successfully:'). |
| |
' <a href="'.$url.'">'. |
| |
$orig_uploaded_filename.'</a><br />'; |
| |
} else { |
| |
$output .= '<font size="+2">'. |
| |
&mt('View embedded file: [_1]','<a href="'.$url.'">'. |
| |
$orig_uploaded_filename.'</a>').'</font><br />'; |
| |
} |
| |
} |
| |
close($fh); |
| |
} |
| |
} |
| |
} |
| |
return $output; |
| |
} |
| |
|
| |
sub check_for_existing { |
| |
my ($path,$fname,$element) = @_; |
| |
my ($state,$msg); |
| |
if (-d $path.'/'.$fname) { |
| |
$state = 'exists'; |
| |
$msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path); |
| |
} elsif (-e $path.'/'.$fname) { |
| |
$state = 'exists'; |
| |
$msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path); |
| |
} |
| |
if ($state eq 'exists') { |
| |
$msg = '<span class="LC_error">'.$msg.'</span><br />'; |
| |
} |
| |
return ($state,$msg); |
| |
} |
| |
|
| |
sub check_for_upload { |
| |
my ($path,$fname,$group,$element,$portfolio_root,$port_path, |
| |
$disk_quota,$current_disk_usage,$uname,$udom) = @_; |
| |
my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?) |
| |
my $getpropath = 1; |
| |
my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname, |
| |
$getpropath); |
| |
my $found_file = 0; |
| |
my $locked_file = 0; |
| |
foreach my $line (@dir_list) { |
| |
my ($file_name)=split(/\&/,$line,2); |
| |
if ($file_name eq $fname){ |
| |
$file_name = $path.$file_name; |
| |
if ($group ne '') { |
| |
$file_name = $group.$file_name; |
| |
} |
| |
$found_file = 1; |
| |
if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') { |
| |
$locked_file = 1; |
| |
} |
| |
} |
| |
} |
| |
my $getpropath = 1; |
| |
if (($current_disk_usage + $filesize) > $disk_quota){ |
| |
my $msg = '<span class="LC_error">'. |
| |
&mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'. |
| |
'<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage); |
| |
return ('will_exceed_quota',$msg); |
| |
} elsif ($found_file) { |
| |
if ($locked_file) { |
| |
my $msg = '<span class="LC_error">'; |
| |
$msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>'); |
| |
$msg .= '</span><br />'; |
| |
$msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>'); |
| |
return ('file_locked',$msg); |
| |
} else { |
| |
my $msg = '<span class="LC_error">'; |
| |
$msg .= &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'}); |
| |
$msg .= '</span>'; |
| |
$msg .= '<br />'; |
| |
$msg .= &mt('To upload, rename or delete existing [_1] in [_2].','<span class="LC_filename">'.$fname.'</span>', $port_path.$env{'form.currentpath'}); |
| |
return ('file_exists',$msg); |
| |
} |
| |
} |
| |
} |
| |
|
| |
|
| =pod |
=pod |
| |
|
|
Line 6841 sub get_env_multiple {
|
Line 7271 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 6871 sub upfile_store {
|
Line 7301 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 6895 sub load_tmp_file {
|
Line 7325 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 6917 sub upfile_record_sep {
|
Line 7347 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 7002 sub record_sep {
|
Line 7432 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 7049 sub get_samples {
|
Line 7479 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 7061 Apache Request ref, $records is an array
|
Line 7491 Apache Request ref, $records is an array
|
| ###################################################### |
###################################################### |
| sub csv_print_samples { |
sub csv_print_samples { |
| my ($r,$records) = @_; |
my ($r,$records) = @_; |
| my $samples = &get_samples($records,3); |
my $samples = &get_samples($records,5); |
| |
|
| $r->print(&mt('Samples').'<br />'.&start_data_table(). |
$r->print(&mt('Samples').'<br />'.&start_data_table(). |
| &start_data_table_header_row()); |
&start_data_table_header_row()); |
|
Line 7085 sub csv_print_samples {
|
Line 7515 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 7116 sub csv_print_select_table {
|
Line 7546 sub csv_print_select_table {
|
| foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
| $r->print('<option value="'.$sample.'"'. |
$r->print('<option value="'.$sample.'"'. |
| ($sample eq $defaultcol ? ' selected="selected" ' : ''). |
($sample eq $defaultcol ? ' selected="selected" ' : ''). |
| '>Column '.($sample+1).'</option>'); |
'>'.&mt('Column [_1]',($sample+1)).'</option>'); |
| } |
} |
| $r->print('</select></td>'.&end_data_table_row()."\n"); |
$r->print('</select></td>'.&end_data_table_row()."\n"); |
| $i++; |
$i++; |
|
Line 7131 sub csv_print_select_table {
|
Line 7561 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 7147 sub csv_samples_select_table {
|
Line 7577 sub csv_samples_select_table {
|
| my ($r,$records,$d) = @_; |
my ($r,$records,$d) = @_; |
| my $i=0; |
my $i=0; |
| # |
# |
| my $samples = &get_samples($records,3); |
my $max_samples = 5; |
| |
my $samples = &get_samples($records,$max_samples); |
| $r->print(&start_data_table(). |
$r->print(&start_data_table(). |
| &start_data_table_header_row().'<th>'. |
&start_data_table_header_row().'<th>'. |
| &mt('Field').'</th><th>'.&mt('Samples').'</th>'. |
&mt('Field').'</th><th>'.&mt('Samples').'</th>'. |
|
Line 7163 sub csv_samples_select_table {
|
Line 7594 sub csv_samples_select_table {
|
| $display.'</option>'); |
$display.'</option>'); |
| } |
} |
| $r->print('</select></td><td>'); |
$r->print('</select></td><td>'); |
| foreach my $line (0..2) { |
foreach my $line (0..($max_samples-1)) { |
| if (defined($samples->[$line]{$key})) { |
if (defined($samples->[$line]{$key})) { |
| $r->print($samples->[$line]{$key}."<br />\n"); |
$r->print($samples->[$line]{$key}."<br />\n"); |
| } |
} |
|
Line 7181 sub csv_samples_select_table {
|
Line 7612 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 7200 sub clean_excel_name {
|
Line 7631 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 7241 sub check_if_partid_hidden {
|
Line 7672 sub check_if_partid_hidden {
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item get_cgi_id |
=item * &get_cgi_id() |
| |
|
| Inputs: none |
Inputs: none |
| |
|
|
Line 7265 sub get_cgi_id {
|
Line 7696 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 7400 sub DrawBarGraph {
|
Line 7831 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 7409 sub DrawBarGraph {
|
Line 7840 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 7490 sub DrawXYGraph {
|
Line 7921 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 7499 sub DrawXYGraph {
|
Line 7930 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 7592 sub DrawXYYGraph {
|
Line 8023 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 7609 Bad place for them but what the hell.
|
Line 8040 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 7648 sub chartlink {
|
Line 8079 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 7724 sub store_settings {
|
Line 8155 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 7761 sub restore_settings {
|
Line 8192 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 7774 defdom (domain for which to retrieve con
|
Line 8205 defdom (domain for which to retrieve con
|
| origmail (scalar - email address of recipient from loncapa.conf, |
origmail (scalar - email address of recipient from loncapa.conf, |
| i.e., predates configuration by DC via domainprefs.pm |
i.e., predates configuration by DC via domainprefs.pm |
| |
|
| Returns: comma separated list of addresses to which to send e-mail. |
Returns: comma separated list of addresses to which to send e-mail. |
| |
|
| |
=back |
| |
|
| =cut |
=cut |
| |
|
|
Line 7825 sub build_recipient_list {
|
Line 8258 sub build_recipient_list {
|
| ############################################################ |
############################################################ |
| ############################################################ |
############################################################ |
| |
|
| |
=pod |
| |
|
| |
=head1 Course Catalog Routines |
| |
|
| |
=over 4 |
| |
|
| |
=item * &gather_categories() |
| |
|
| |
Converts category definitions - keys of categories hash stored in |
| |
coursecategories in configuration.db on the primary library server in a |
| |
domain - to an array. Also generates javascript and idx hash used to |
| |
generate Domain Coordinator interface for editing Course Categories. |
| |
|
| |
Inputs: |
| |
|
| |
categories (reference to hash of category definitions). |
| |
|
| |
cats (reference to array of arrays/hashes which encapsulates hierarchy of |
| |
categories and subcategories). |
| |
|
| |
idx (reference to hash of counters used in Domain Coordinator interface for |
| |
editing Course Categories). |
| |
|
| |
jsarray (reference to array of categories used to create Javascript arrays for |
| |
Domain Coordinator interface for editing Course Categories). |
| |
|
| |
Returns: nothing |
| |
|
| |
Side effects: populates cats, idx and jsarray. |
| |
|
| |
=cut |
| |
|
| |
sub gather_categories { |
| |
my ($categories,$cats,$idx,$jsarray) = @_; |
| |
my %counters; |
| |
my $num = 0; |
| |
foreach my $item (keys(%{$categories})) { |
| |
my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item); |
| |
if ($container eq '' && $depth == 0) { |
| |
$cats->[$depth][$categories->{$item}] = $cat; |
| |
} else { |
| |
$cats->[$depth]{$container}[$categories->{$item}] = $cat; |
| |
} |
| |
my ($escitem,$tail) = split(/:/,$item,2); |
| |
if ($counters{$tail} eq '') { |
| |
$counters{$tail} = $num; |
| |
$num ++; |
| |
} |
| |
if (ref($idx) eq 'HASH') { |
| |
$idx->{$item} = $counters{$tail}; |
| |
} |
| |
if (ref($jsarray) eq 'ARRAY') { |
| |
push(@{$jsarray->[$counters{$tail}]},$item); |
| |
} |
| |
} |
| |
return; |
| |
} |
| |
|
| |
=pod |
| |
|
| |
=item * &extract_categories() |
| |
|
| |
Used to generate breadcrumb trails for course categories. |
| |
|
| |
Inputs: |
| |
|
| |
categories (reference to hash of category definitions). |
| |
|
| |
cats (reference to array of arrays/hashes which encapsulates hierarchy of |
| |
categories and subcategories). |
| |
|
| |
trails (reference to array of breacrumb trails for each category). |
| |
|
| |
allitems (reference to hash - key is category key |
| |
(format: escaped(name):escaped(parent category):depth in hierarchy). |
| |
|
| |
idx (reference to hash of counters used in Domain Coordinator interface for |
| |
editing Course Categories). |
| |
|
| |
jsarray (reference to array of categories used to create Javascript arrays for |
| |
Domain Coordinator interface for editing Course Categories). |
| |
|
| |
Returns: nothing |
| |
|
| |
Side effects: populates trails and allitems hash references. |
| |
|
| |
=cut |
| |
|
| |
sub extract_categories { |
| |
my ($categories,$cats,$trails,$allitems,$idx,$jsarray) = @_; |
| |
if (ref($categories) eq 'HASH') { |
| |
&gather_categories($categories,$cats,$idx,$jsarray); |
| |
if (ref($cats->[0]) eq 'ARRAY') { |
| |
for (my $i=0; $i<@{$cats->[0]}; $i++) { |
| |
my $name = $cats->[0][$i]; |
| |
my $item = &escape($name).'::0'; |
| |
my $trailstr; |
| |
if ($name eq 'instcode') { |
| |
$trailstr = &mt('Official courses (with institutional codes)'); |
| |
} else { |
| |
$trailstr = $name; |
| |
} |
| |
if ($allitems->{$item} eq '') { |
| |
push(@{$trails},$trailstr); |
| |
$allitems->{$item} = scalar(@{$trails})-1; |
| |
} |
| |
my @parents = ($name); |
| |
if (ref($cats->[1]{$name}) eq 'ARRAY') { |
| |
for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) { |
| |
my $category = $cats->[1]{$name}[$j]; |
| |
&recurse_categories($cats,2,$category,$trails,$allitems,\@parents); |
| |
} |
| |
} |
| |
} |
| |
} |
| |
} |
| |
return; |
| |
} |
| |
|
| |
=pod |
| |
|
| |
=item *&recurse_categories() |
| |
|
| |
Recursively used to generate breadcrumb trails for course categories. |
| |
|
| |
Inputs: |
| |
|
| |
cats (reference to array of arrays/hashes which encapsulates hierarchy of |
| |
categories and subcategories). |
| |
|
| |
depth (current depth in hierarchy of categories and sub-categories - 0 indexed). |
| |
|
| |
category (current course category, for which breadcrumb trail is being generated). |
| |
|
| |
trails (reference to array of breadcrumb trails for each category). |
| |
|
| |
allitems (reference to hash - key is category key |
| |
(format: escaped(name):escaped(parent category):depth in hierarchy). |
| |
|
| |
parents (array containing containers directories for current category, |
| |
back to top level). |
| |
|
| |
Returns: nothing |
| |
|
| |
Side effects: populates trails and allitems hash references |
| |
|
| |
=cut |
| |
|
| |
sub recurse_categories { |
| |
my ($cats,$depth,$category,$trails,$allitems,$parents) = @_; |
| |
my $shallower = $depth - 1; |
| |
if (ref($cats->[$depth]{$category}) eq 'ARRAY') { |
| |
for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) { |
| |
my $name = $cats->[$depth]{$category}[$k]; |
| |
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower; |
| |
my $trailstr = join(' -> ',(@{$parents},$category)); |
| |
if ($allitems->{$item} eq '') { |
| |
push(@{$trails},$trailstr); |
| |
$allitems->{$item} = scalar(@{$trails})-1; |
| |
} |
| |
my $deeper = $depth+1; |
| |
push(@{$parents},$category); |
| |
&recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents); |
| |
pop(@{$parents}); |
| |
} |
| |
} else { |
| |
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower; |
| |
my $trailstr = join(' -> ',(@{$parents},$category)); |
| |
if ($allitems->{$item} eq '') { |
| |
push(@{$trails},$trailstr); |
| |
$allitems->{$item} = scalar(@{$trails})-1; |
| |
} |
| |
} |
| |
return; |
| |
} |
| |
|
| |
=pod |
| |
|
| |
=item *&assign_categories_table() |
| |
|
| |
Create a datatable for display of hierarchical categories in a domain, |
| |
with checkboxes to allow a course to be categorized. |
| |
|
| |
Inputs: |
| |
|
| |
cathash - reference to hash of categories defined for the domain (from |
| |
configuration.db) |
| |
|
| |
currcat - scalar with an & separated list of categories assigned to a course. |
| |
|
| |
Returns: $output (markup to be displayed) |
| |
|
| |
=cut |
| |
|
| |
sub assign_categories_table { |
| |
my ($cathash,$currcat) = @_; |
| |
my $output; |
| |
if (ref($cathash) eq 'HASH') { |
| |
my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth); |
| |
&extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray); |
| |
$maxdepth = scalar(@cats); |
| |
if (@cats > 0) { |
| |
my $itemcount = 0; |
| |
if (ref($cats[0]) eq 'ARRAY') { |
| |
$output = &Apache::loncommon::start_data_table(); |
| |
my @currcategories; |
| |
if ($currcat ne '') { |
| |
@currcategories = split('&',$currcat); |
| |
} |
| |
for (my $i=0; $i<@{$cats[0]}; $i++) { |
| |
my $parent = $cats[0][$i]; |
| |
my $css_class = $itemcount%2?' class="LC_odd_row"':''; |
| |
next if ($parent eq 'instcode'); |
| |
my $item = &escape($parent).'::0'; |
| |
my $checked = ''; |
| |
if (@currcategories > 0) { |
| |
if (grep(/^\Q$item\E$/,@currcategories)) { |
| |
$checked = ' checked="checked" '; |
| |
} |
| |
} |
| |
$output .= '<tr '.$css_class.'><td><span class="LC_nobreak">' |
| |
.'<input type="checkbox" name="usecategory" value="'. |
| |
$item.'"'.$checked.' />'.&escape($parent).'</span></td>'; |
| |
my $depth = 1; |
| |
push(@path,$parent); |
| |
$output .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories); |
| |
pop(@path); |
| |
$output .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>'; |
| |
$itemcount ++; |
| |
} |
| |
$output .= &Apache::loncommon::end_data_table(); |
| |
} |
| |
} |
| |
} |
| |
return $output; |
| |
} |
| |
|
| |
=pod |
| |
|
| |
=item *&assign_category_rows() |
| |
|
| |
Create a datatable row for display of nested categories in a domain, |
| |
with checkboxes to allow a course to be categorized,called recursively. |
| |
|
| |
Inputs: |
| |
|
| |
itemcount - track row number for alternating colors |
| |
|
| |
cats - reference to array of arrays/hashes which encapsulates hierarchy of |
| |
categories and subcategories. |
| |
|
| |
depth - current depth in hierarchy of categories and sub-categories - 0 indexed. |
| |
|
| |
parent - parent of current category item |
| |
|
| |
path - Array containing all categories back up through the hierarchy from the |
| |
current category to the top level. |
| |
|
| |
currcategories - reference to array of current categories assigned to the course |
| |
|
| |
Returns: $output (markup to be displayed). |
| |
|
| |
=cut |
| |
|
| |
sub assign_category_rows { |
| |
my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_; |
| |
my ($text,$name,$item,$chgstr); |
| |
if (ref($cats) eq 'ARRAY') { |
| |
my $maxdepth = scalar(@{$cats}); |
| |
if (ref($cats->[$depth]) eq 'HASH') { |
| |
if (ref($cats->[$depth]{$parent}) eq 'ARRAY') { |
| |
my $numchildren = @{$cats->[$depth]{$parent}}; |
| |
my $css_class = $itemcount%2?' class="LC_odd_row"':''; |
| |
$text .= '<td><table class="LC_datatable">'; |
| |
for (my $j=0; $j<$numchildren; $j++) { |
| |
$name = $cats->[$depth]{$parent}[$j]; |
| |
$item = &escape($name).':'.&escape($parent).':'.$depth; |
| |
my $deeper = $depth+1; |
| |
my $checked = ''; |
| |
if (ref($currcategories) eq 'ARRAY') { |
| |
if (@{$currcategories} > 0) { |
| |
if (grep(/^\Q$item\E$/,@{$currcategories})) { |
| |
$checked = ' checked="checked" '; |
| |
} |
| |
} |
| |
} |
| |
$text .= '<tr><td><span class="LC_nobreak"><label>'. |
| |
'<input type="checkbox" name="usecategory" value="'. |
| |
$item.'"'.$checked.' />'.$name.'</label></span></td><td>'; |
| |
if (ref($path) eq 'ARRAY') { |
| |
push(@{$path},$name); |
| |
$text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories); |
| |
pop(@{$path}); |
| |
} |
| |
$text .= '</td></tr>'; |
| |
} |
| |
$text .= '</table></td>'; |
| |
} |
| |
} |
| |
} |
| |
return $text; |
| |
} |
| |
|
| |
############################################################ |
| |
############################################################ |
| |
|
| |
|
| sub commit_customrole { |
sub commit_customrole { |
| my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_; |
my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_; |
| 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( |
| $udom,$uname,$url,$three,$four,$five,$end,$start). |
$udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context). |
| '</b><br />'; |
'</b><br />'; |
| return $output; |
return $output; |
| } |
} |
|
Line 7866 sub commit_standardrole {
|
Line 8606 sub commit_standardrole {
|
| $output = &mt('Assigning').' '.$three.' in '.$url. |
$output = &mt('Assigning').' '.$three.' in '.$url. |
| ($start?', '.&mt('starting').' '.localtime($start):''). |
($start?', '.&mt('starting').' '.localtime($start):''). |
| ($end?', '.&mt('ending').' '.localtime($end):'').': '; |
($end?', '.&mt('ending').' '.localtime($end):'').': '; |
| my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start); |
my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context); |
| if ($context eq 'auto') { |
if ($context eq 'auto') { |
| $output .= $result.$linefeed; |
$output .= $result.$linefeed; |
| } else { |
} else { |
|
Line 7901 sub commit_studentrole {
|
Line 8641 sub commit_studentrole {
|
| } |
} |
| $oldsecurl = $uurl; |
$oldsecurl = $uurl; |
| $expire_role_result = |
$expire_role_result = |
| &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now); |
&Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context); |
| if ($env{'request.course.sec'} ne '') { |
if ($env{'request.course.sec'} ne '') { |
| if ($expire_role_result eq 'refused') { |
if ($expire_role_result eq 'refused') { |
| my @roles = ('st'); |
my @roles = ('st'); |
|
Line 7924 sub commit_studentrole {
|
Line 8664 sub commit_studentrole {
|
| } |
} |
| } |
} |
| if (($expire_role_result eq 'ok') || ($secchange == 0)) { |
if (($expire_role_result eq 'ok') || ($secchange == 0)) { |
| $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,'',$context); |
| if ($modify_section_result =~ /^ok/) { |
if ($modify_section_result =~ /^ok/) { |
| if ($secchange == 1) { |
if ($secchange == 1) { |
| if ($sec eq '') { |
if ($sec eq '') { |
|
Line 8087 sub construct_course {
|
Line 8827 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 |
|
Line 8134 sub construct_course {
|
Line 8874 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'} = ''; |
![[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