version 1.1165, 2013/12/24 19:15:10
|
version 1.1187, 2014/04/25 17:56:43
|
Line 69 use Apache::lontexconvert();
|
Line 69 use Apache::lontexconvert();
|
use Apache::lonclonecourse(); |
use Apache::lonclonecourse(); |
use Apache::lonuserutils(); |
use Apache::lonuserutils(); |
use Apache::lonuserstate(); |
use Apache::lonuserstate(); |
|
use Apache::courseclassifier(); |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
use DateTime::TimeZone; |
use DateTime::TimeZone; |
use DateTime::Locale::Catalog; |
use DateTime::Locale::Catalog; |
use Text::Aspell; |
use Text::Aspell; |
use Authen::Captcha; |
use Authen::Captcha; |
use Captcha::reCAPTCHA; |
use Captcha::reCAPTCHA; |
|
use Crypt::DES; |
|
use DynaLoader; # for Crypt::DES version |
|
|
# ---------------------------------------------- Designs |
# ---------------------------------------------- Designs |
use vars qw(%defaultdesign); |
use vars qw(%defaultdesign); |
Line 1313 sub helpLatexCheatsheet {
|
Line 1316 sub helpLatexCheatsheet {
|
.&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600) |
.&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600) |
.'</span>'; |
.'</span>'; |
unless ($not_author) { |
unless ($not_author) { |
$out .= ' <span>' |
$out .= '<span>' |
.&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600) |
.&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600) |
|
.'</span> <span>' |
|
.&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600) |
.'</span>'; |
.'</span>'; |
} |
} |
$out .= '</span>'; # End cheatsheet |
$out .= '</span>'; # End cheatsheet |
Line 1380 sub top_nav_help {
|
Line 1385 sub top_nav_help {
|
$text = &mt($text); |
$text = &mt($text); |
my $stay_on_page = 1; |
my $stay_on_page = 1; |
|
|
my $link = ($stay_on_page) ? "javascript:helpMenu('display')" |
my ($link,$banner_link); |
: "javascript:helpMenu('open')"; |
unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) { |
my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page); |
$link = ($stay_on_page) ? "javascript:helpMenu('display')" |
|
: "javascript:helpMenu('open')"; |
|
$banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page); |
|
} |
my $title = &mt('Get help'); |
my $title = &mt('Get help'); |
|
if ($link) { |
return <<"END"; |
return <<"END"; |
$banner_link |
$banner_link |
<a href="$link" title="$title">$text</a> |
<a href="$link" title="$title">$text</a> |
END |
END |
|
} else { |
|
return ' '.$text.' '; |
|
} |
} |
} |
|
|
sub help_menu_js { |
sub help_menu_js { |
Line 1406 sub help_menu_js {
|
Line 1416 sub help_menu_js {
|
'js_ready' => 1, |
'js_ready' => 1, |
'use_absolute' => $httphost, |
'use_absolute' => $httphost, |
'add_entries' => { |
'add_entries' => { |
'border' => '0', |
'border' => '0', |
'rows' => "110,*",},}); |
'rows' => "110,*",},}); |
my $end_page = |
my $end_page = |
&Apache::loncommon::end_page({'frameset' => 1, |
&Apache::loncommon::end_page({'frameset' => 1, |
Line 1436 function helpMenu(target) {
|
Line 1446 function helpMenu(target) {
|
return; |
return; |
} |
} |
function writeHelp(caller) { |
function writeHelp(caller) { |
caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" />\\n<frame name="bodyframe" src="$details_link" />\\n$end_page') |
caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n'); |
caller.document.close() |
caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page'); |
caller.focus() |
caller.document.close(); |
|
caller.focus(); |
} |
} |
// END LON-CAPA Internal --> |
// END LON-CAPA Internal --> |
// ]]> |
// ]]> |
Line 3884 sub get_previous_attempt {
|
Line 3895 sub get_previous_attempt {
|
if ($key =~/$regexp$/ && (defined &$gradesub)) { |
if ($key =~/$regexp$/ && (defined &$gradesub)) { |
$value = &$gradesub($value); |
$value = &$gradesub($value); |
} |
} |
$prevattempts.='<td>'.$value.' </td>'; |
$prevattempts.='<td>'. $value.' </td>'; |
} else { |
} else { |
$prevattempts.='<td> </td>'; |
$prevattempts.='<td> </td>'; |
} |
} |
Line 3900 sub get_previous_attempt {
|
Line 3911 sub get_previous_attempt {
|
if ($key =~/$regexp$/ && (defined &$gradesub)) { |
if ($key =~/$regexp$/ && (defined &$gradesub)) { |
$value = &$gradesub($value); |
$value = &$gradesub($value); |
} |
} |
$prevattempts.='<td>'.$value.' </td>'; |
$prevattempts.='<td>'.$value.' </td>'; |
} |
} |
} |
} |
$prevattempts.= &end_data_table_row().&end_data_table(); |
$prevattempts.= &end_data_table_row().&end_data_table(); |
Line 3921 sub get_previous_attempt {
|
Line 3932 sub get_previous_attempt {
|
sub format_previous_attempt_value { |
sub format_previous_attempt_value { |
my ($key,$value) = @_; |
my ($key,$value) = @_; |
if (($key =~ /timestamp/) || ($key=~/duedate/)) { |
if (($key =~ /timestamp/) || ($key=~/duedate/)) { |
$value = &Apache::lonlocal::locallocaltime($value); |
$value = &Apache::lonlocal::locallocaltime($value); |
} elsif (ref($value) eq 'ARRAY') { |
} elsif (ref($value) eq 'ARRAY') { |
$value = '('.join(', ', @{ $value }).')'; |
$value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&'); |
} elsif ($key =~ /answerstring$/) { |
} elsif ($key =~ /answerstring$/) { |
my %answers = &Apache::lonnet::str2hash($value); |
my %answers = &Apache::lonnet::str2hash($value); |
|
my @answer = %answers; |
|
%answers = map {&HTML::Entities::encode($_, '"<>&')} @answer; |
my @anskeys = sort(keys(%answers)); |
my @anskeys = sort(keys(%answers)); |
if (@anskeys == 1) { |
if (@anskeys == 1) { |
my $answer = $answers{$anskeys[0]}; |
my $answer = $answers{$anskeys[0]}; |
Line 3948 sub format_previous_attempt_value {
|
Line 3961 sub format_previous_attempt_value {
|
} |
} |
} |
} |
} else { |
} else { |
$value = &unescape($value); |
$value = &HTML::Entities::encode(&unescape($value), '"<>&'); |
} |
} |
return $value; |
return $value; |
} |
} |
Line 5141 sub bodytag {
|
Line 5154 sub bodytag {
|
@design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; |
@design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; |
|
|
# role and realm |
# role and realm |
my ($role,$realm) = split(/\./,$env{'request.role'},2); |
my ($role,$realm) = split(m{\./},$env{'request.role'},2); |
|
if ($realm) { |
|
$realm = '/'.$realm; |
|
} |
if ($role eq 'ca') { |
if ($role eq 'ca') { |
my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$}); |
my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$}); |
$realm = &plainname($rname,$rdom); |
$realm = &plainname($rname,$rdom); |
Line 5222 sub bodytag {
|
Line 5238 sub bodytag {
|
} |
} |
$bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|; |
$bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|; |
|
|
|
#if directed to not display the secondary menu, don't. |
|
if ($args->{'no_secondary_menu'}) { |
|
return $bodytag; |
|
} |
#don't show menus for public users |
#don't show menus for public users |
if (!$public){ |
if (!$public){ |
$bodytag .= Apache::lonmenu::secondary_menu($httphost); |
$bodytag .= Apache::lonmenu::secondary_menu($httphost); |
Line 7330 ADDMETA
|
Line 7350 ADDMETA
|
} |
} |
if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); } |
if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); } |
$result .= '<title> LON-CAPA '.$title.'</title>' |
$result .= '<title> LON-CAPA '.$title.'</title>' |
.'<link rel="stylesheet" type="text/css" href="'.$url.'" />' |
.'<link rel="stylesheet" type="text/css" href="'.$url.'"'; |
|
if (!$args->{'frameset'}) { |
|
$result .= ' /'; |
|
} |
|
$result .= '>' |
.$inhibitprint |
.$inhibitprint |
.$head_extra; |
.$head_extra; |
if ($env{'browser.mobile'}) { |
if ($env{'browser.mobile'}) { |
Line 7356 sub font_settings {
|
Line 7380 sub font_settings {
|
my $headerstring=''; |
my $headerstring=''; |
if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) || |
if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) || |
((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) { |
((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) { |
$headerstring.= |
$headerstring.= |
'<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'."\n"; |
'<meta http-equiv="Content-Type" content="text/html; charset=utf-8"'; |
|
if (!$args->{'frameset'}) { |
|
$headerstring.= ' /'; |
|
} |
|
$headerstring .= '>'."\n"; |
} |
} |
return $headerstring; |
return $headerstring; |
} |
} |
Line 7449 Inputs: none
|
Line 7477 Inputs: none
|
=cut |
=cut |
|
|
sub xml_begin { |
sub xml_begin { |
|
my ($is_frameset) = @_; |
my $output=''; |
my $output=''; |
|
|
if ($env{'browser.mathml'}) { |
if ($env{'browser.mathml'}) { |
Line 7460 sub xml_begin {
|
Line 7489 sub xml_begin {
|
.'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">' |
.'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">' |
.'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' |
.'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' |
.'xmlns="http://www.w3.org/1999/xhtml">'; |
.'xmlns="http://www.w3.org/1999/xhtml">'; |
|
} elsif ($is_frameset) { |
|
$output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n". |
|
'<html>'."\n"; |
} else { |
} else { |
$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n" |
$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n". |
.'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n"; |
'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n"; |
} |
} |
return $output; |
return $output; |
} |
} |
Line 7529 sub start_page {
|
Line 7561 sub start_page {
|
my ($result,@advtools); |
my ($result,@advtools); |
|
|
if (! exists($args->{'skip_phases'}{'head'}) ) { |
if (! exists($args->{'skip_phases'}{'head'}) ) { |
$result .= &xml_begin() . &headtag($title, $head_extra, $args); |
$result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args); |
} |
} |
|
|
if (! exists($args->{'skip_phases'}{'body'}) ) { |
if (! exists($args->{'skip_phases'}{'body'}) ) { |
Line 7630 function set_wishlistlink(title, path) {
|
Line 7662 function set_wishlistlink(title, path) {
|
title = document.title; |
title = document.title; |
title = title.replace(/^LON-CAPA /,''); |
title = title.replace(/^LON-CAPA /,''); |
} |
} |
|
title = encodeURIComponent(title); |
if (!path) { |
if (!path) { |
path = location.pathname; |
path = location.pathname; |
} |
} |
|
path = encodeURIComponent(path); |
Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path, |
Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path, |
'wishlistNewLink','width=560,height=350,scrollbars=0'); |
'wishlistNewLink','width=560,height=350,scrollbars=0'); |
} |
} |
Line 8939 sub excess_filesize_warning {
|
Line 8973 sub excess_filesize_warning {
|
} |
} |
$disk_quota = int($disk_quota * 1000); |
$disk_quota = int($disk_quota * 1000); |
if (($current_disk_usage + $filesize) > $disk_quota) { |
if (($current_disk_usage + $filesize) > $disk_quota) { |
return '<p><span class="LC_warning">'. |
return '<p class="LC_warning">'. |
&mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.", |
&mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.", |
'<span class="LC_filename">'.$filename.'</span>',$filesize).'</span>'. |
'<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'. |
'<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.', |
'<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.', |
$disk_quota,$current_disk_usage). |
$disk_quota,$current_disk_usage). |
'</p>'; |
'</p>'; |
} |
} |
Line 9395 sub personal_data_fieldtitles {
|
Line 9429 sub personal_data_fieldtitles {
|
|
|
sub sorted_inst_types { |
sub sorted_inst_types { |
my ($dom) = @_; |
my ($dom) = @_; |
my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); |
my ($usertypes,$order); |
|
my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); |
|
if (ref($domdefaults{'inststatus'}) eq 'HASH') { |
|
$usertypes = $domdefaults{'inststatus'}{'inststatustypes'}; |
|
$order = $domdefaults{'inststatus'}{'inststatusorder'}; |
|
} else { |
|
($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); |
|
} |
my $othertitle = &mt('All users'); |
my $othertitle = &mt('All users'); |
if ($env{'request.course.id'}) { |
if ($env{'request.course.id'}) { |
$othertitle = &mt('Any users'); |
$othertitle = &mt('Any users'); |
Line 10889 sub check_for_upload {
|
Line 10930 sub check_for_upload {
|
if ($currsize < $filesize) { |
if ($currsize < $filesize) { |
my $extra = $filesize - $currsize; |
my $extra = $filesize - $currsize; |
if (($current_disk_usage + $extra) > $disk_quota) { |
if (($current_disk_usage + $extra) > $disk_quota) { |
my $msg = '<span class="LC_error">'. |
my $msg = '<p class="LC_warning">'. |
&mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.', |
&mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.', |
'<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'. |
'<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'. |
'<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.', |
'<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.', |
$disk_quota,$current_disk_usage); |
$disk_quota,$current_disk_usage).'</p>'; |
return ('will_exceed_quota',$msg); |
return ('will_exceed_quota',$msg); |
} |
} |
} |
} |
Line 10902 sub check_for_upload {
|
Line 10943 sub check_for_upload {
|
} |
} |
} |
} |
if (($current_disk_usage + $filesize) > $disk_quota){ |
if (($current_disk_usage + $filesize) > $disk_quota){ |
my $msg = '<span class="LC_error">'. |
my $msg = '<p class="LC_warning">'. |
&mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'. |
&mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'. |
'<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage); |
'<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>'; |
return ('will_exceed_quota',$msg); |
return ('will_exceed_quota',$msg); |
} elsif ($found_file) { |
} elsif ($found_file) { |
if ($locked_file) { |
if ($locked_file) { |
my $msg = '<span class="LC_error">'; |
my $msg = '<p class="LC_warning">'; |
$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 .= &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 .= '</p>'; |
$msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>'); |
$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); |
return ('file_locked',$msg); |
} else { |
} else { |
my $msg = '<span class="LC_error">'; |
my $msg = '<p class="LC_error">'; |
$msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'}); |
$msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'}); |
$msg .= '</span>'; |
$msg .= '</p>'; |
return ('existingfile',$msg); |
return ('existingfile',$msg); |
} |
} |
} |
} |
Line 11241 sub decompress_uploaded_file {
|
Line 11282 sub decompress_uploaded_file {
|
sub process_decompression { |
sub process_decompression { |
my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; |
my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; |
my ($dir,$error,$warning,$output); |
my ($dir,$error,$warning,$output); |
if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) { |
if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) { |
$error = &mt('Filename not a supported archive file type.'). |
$error = &mt('Filename not a supported archive file type.'). |
'<br />'.&mt('Filename should end with one of: [_1].', |
'<br />'.&mt('Filename should end with one of: [_1].', |
'.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz'); |
'.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz'); |
Line 13632 sub assign_category_rows {
|
Line 13673 sub assign_category_rows {
|
return $text; |
return $text; |
} |
} |
|
|
|
=pod |
|
|
|
=back |
|
|
|
=cut |
|
|
############################################################ |
############################################################ |
############################################################ |
############################################################ |
|
|
Line 13884 sub check_clone {
|
Line 13931 sub check_clone {
|
} |
} |
|
|
sub construct_course { |
sub construct_course { |
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_; |
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_; |
my $outcome; |
my $outcome; |
my $linefeed = '<br />'."\n"; |
my $linefeed = '<br />'."\n"; |
if ($context eq 'auto') { |
if ($context eq 'auto') { |
Line 13981 sub construct_course {
|
Line 14028 sub construct_course {
|
'plc.users.denied', |
'plc.users.denied', |
'hidefromcat', |
'hidefromcat', |
'checkforpriv', |
'checkforpriv', |
'categories'], |
'categories', |
|
'internal.uniquecode'], |
$$crsudom,$$crsunum); |
$$crsudom,$$crsunum); |
|
if ($args->{'textbook'}) { |
|
$cenv{'internal.textbook'} = $args->{'textbook'}; |
|
} |
} |
} |
|
|
# |
# |
Line 14166 sub construct_course {
|
Line 14217 sub construct_course {
|
} |
} |
} |
} |
|
|
|
# |
|
# generate and store uniquecode (available to course requester), if course should have one. |
|
# |
|
if ($args->{'uniquecode'}) { |
|
my ($code,$error) = &make_unique_code($$crsudom,$$crsunum); |
|
if ($code) { |
|
$cenv{'internal.uniquecode'} = $code; |
|
my %crsinfo = |
|
&Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.'); |
|
if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') { |
|
$crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code; |
|
my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime'); |
|
} |
|
if (ref($coderef)) { |
|
$$coderef = $code; |
|
} |
|
} |
|
} |
|
|
if ($args->{'disresdis'}) { |
if ($args->{'disresdis'}) { |
$cenv{'pch.roles.denied'}='st'; |
$cenv{'pch.roles.denied'}='st'; |
} |
} |
Line 14234 sub construct_course {
|
Line 14304 sub construct_course {
|
return (1,$outcome); |
return (1,$outcome); |
} |
} |
|
|
|
sub make_unique_code { |
|
my ($cdom,$cnum) = @_; |
|
# get lock on uniquecodes db |
|
my $lockhash = { |
|
$cnum."\0".'uniquecodes' => $env{'user.name'}. |
|
':'.$env{'user.domain'}, |
|
}; |
|
my $tries = 0; |
|
my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom); |
|
my ($code,$error); |
|
|
|
while (($gotlock ne 'ok') && ($tries<3)) { |
|
$tries ++; |
|
sleep 1; |
|
$gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom); |
|
} |
|
if ($gotlock eq 'ok') { |
|
my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom); |
|
my $gotcode; |
|
my $attempts = 0; |
|
while ((!$gotcode) && ($attempts < 100)) { |
|
$code = &generate_code(); |
|
if (!exists($currcodes{$code})) { |
|
$gotcode = 1; |
|
unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') { |
|
$error = 'nostore'; |
|
} |
|
} |
|
$attempts ++; |
|
} |
|
my @del_lock = ($cnum."\0".'uniquecodes'); |
|
my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom); |
|
} else { |
|
$error = 'nolock'; |
|
} |
|
return ($code,$error); |
|
} |
|
|
|
sub generate_code { |
|
my $code; |
|
my @letts = qw(B C D G H J K M N P Q R S T V W X Z); |
|
for (my $i=0; $i<6; $i++) { |
|
my $lettnum = int (rand 2); |
|
my $item = ''; |
|
if ($lettnum) { |
|
$item = $letts[int( rand(18) )]; |
|
} else { |
|
$item = 1+int( rand(8) ); |
|
} |
|
$code .= $item; |
|
} |
|
return $code; |
|
} |
|
|
############################################################ |
############################################################ |
############################################################ |
############################################################ |
|
|
Line 14574 sub clean_symb {
|
Line 14698 sub clean_symb {
|
return ($symb,$enc); |
return ($symb,$enc); |
} |
} |
|
|
|
############################################################ |
|
############################################################ |
|
|
|
=pod |
|
|
|
=head1 Routines for building display used to search for courses |
|
|
|
|
|
=over 4 |
|
|
|
=item * &build_filters() |
|
|
|
Create markup for a table used to set filters to use when selecting |
|
courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm |
|
and quotacheck.pl |
|
|
|
|
|
Inputs: |
|
|
|
filterlist - anonymous array of fields to include as potential filters |
|
|
|
crstype - course type |
|
|
|
roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used |
|
to pop-open a course selector (will contain "extra element"). |
|
|
|
multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1 |
|
|
|
filter - anonymous hash of criteria and their values |
|
|
|
action - form action |
|
|
|
numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number) |
|
|
|
caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm) |
|
|
|
cloneruname - username of owner of new course who wants to clone |
|
|
|
clonerudom - domain of owner of new course who wants to clone |
|
|
|
typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) |
|
|
|
codetitlesref - reference to array of titles of components in institutional codes (official courses) |
|
|
|
codedom - domain |
|
|
|
formname - value of form element named "form". |
|
|
|
fixeddom - domain, if fixed. |
|
|
|
prevphase - value to assign to form element named "phase" when going back to the previous screen |
|
|
|
cnameelement - name of form element in form on opener page which will receive title of selected course |
|
|
|
cnumelement - name of form element in form on opener page which will receive courseID of selected course |
|
|
|
cdomelement - name of form element in form on opener page which will receive domain of selected course |
|
|
|
setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file |
|
|
|
clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course |
|
|
|
clonewarning - warning message about missing information for intended course owner when DC creates a course |
|
|
|
|
|
Returns: $output - HTML for display of search criteria, and hidden form elements. |
|
|
|
|
|
Side Effects: None |
|
|
|
=cut |
|
|
|
# ---------------------------------------------- search for courses based on last activity etc. |
|
|
|
sub build_filters { |
|
my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action, |
|
$numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement, |
|
$codetitlesref,$codedom,$formname,$fixeddom,$prevphase, |
|
$cnameelement,$cnumelement,$cdomelement,$setroles, |
|
$clonetext,$clonewarning) = @_; |
|
my ($list,$jscript); |
|
my $onchange = 'javascript:updateFilters(this)'; |
|
my ($domainselectform,$sincefilterform,$createdfilterform, |
|
$ownerdomselectform,$persondomselectform,$instcodeform, |
|
$typeselectform,$instcodetitle); |
|
if ($formname eq '') { |
|
$formname = $caller; |
|
} |
|
foreach my $item (@{$filterlist}) { |
|
unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') || |
|
($item eq 'sincefilter') || ($item eq 'createdfilter')) { |
|
if ($item eq 'domainfilter') { |
|
$filter->{$item} = &LONCAPA::clean_domain($filter->{$item}); |
|
} elsif ($item eq 'coursefilter') { |
|
$filter->{$item} = &LONCAPA::clean_courseid($filter->{$item}); |
|
} elsif ($item eq 'ownerfilter') { |
|
$filter->{$item} = &LONCAPA::clean_username($filter->{$item}); |
|
} elsif ($item eq 'ownerdomfilter') { |
|
$filter->{'ownerdomfilter'} = |
|
&LONCAPA::clean_domain($filter->{$item}); |
|
$ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'}, |
|
'ownerdomfilter',1); |
|
} elsif ($item eq 'personfilter') { |
|
$filter->{$item} = &LONCAPA::clean_username($filter->{$item}); |
|
} elsif ($item eq 'persondomfilter') { |
|
$persondomselectform = &select_dom_form($filter->{'persondomfilter'}, |
|
'persondomfilter',1); |
|
} else { |
|
$filter->{$item} =~ s/\W//g; |
|
} |
|
if (!$filter->{$item}) { |
|
$filter->{$item} = ''; |
|
} |
|
} |
|
if ($item eq 'domainfilter') { |
|
my $allow_blank = 1; |
|
if ($formname eq 'portform') { |
|
$allow_blank=0; |
|
} elsif ($formname eq 'studentform') { |
|
$allow_blank=0; |
|
} |
|
if ($fixeddom) { |
|
$domainselectform = '<input type="hidden" name="domainfilter"'. |
|
' value="'.$codedom.'" />'. |
|
&Apache::lonnet::domain($codedom,'description'); |
|
} else { |
|
$domainselectform = &select_dom_form($filter->{$item}, |
|
'domainfilter', |
|
$allow_blank,'',$onchange); |
|
} |
|
} else { |
|
$list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"'); |
|
} |
|
} |
|
|
|
# last course activity filter and selection |
|
$sincefilterform = &timebased_select_form('sincefilter',$filter); |
|
|
|
# course created filter and selection |
|
if (exists($filter->{'createdfilter'})) { |
|
$createdfilterform = &timebased_select_form('createdfilter',$filter); |
|
} |
|
|
|
my %lt = &Apache::lonlocal::texthash( |
|
'cac' => "$crstype Activity", |
|
'ccr' => "$crstype Created", |
|
'cde' => "$crstype Title", |
|
'cdo' => "$crstype Domain", |
|
'ins' => 'Institutional Code', |
|
'inc' => 'Institutional Categorization', |
|
'cow' => "$crstype Owner/Co-owner", |
|
'cop' => "$crstype Personnel Includes", |
|
'cog' => 'Type', |
|
); |
|
|
|
if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) { |
|
my $typeval = 'Course'; |
|
if ($crstype eq 'Community') { |
|
$typeval = 'Community'; |
|
} |
|
$typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />'; |
|
} else { |
|
$typeselectform = '<select name="type" size="1"'; |
|
if ($onchange) { |
|
$typeselectform .= ' onchange="'.$onchange.'"'; |
|
} |
|
$typeselectform .= '>'."\n"; |
|
foreach my $posstype ('Course','Community') { |
|
$typeselectform.='<option value="'.$posstype.'"'. |
|
($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n"; |
|
} |
|
$typeselectform.="</select>"; |
|
} |
|
|
|
my ($cloneableonlyform,$cloneabletitle); |
|
if (exists($filter->{'cloneableonly'})) { |
|
my $cloneableon = ''; |
|
my $cloneableoff = ' checked="checked"'; |
|
if ($filter->{'cloneableonly'}) { |
|
$cloneableon = $cloneableoff; |
|
$cloneableoff = ''; |
|
} |
|
$cloneableonlyform = '<span class="LC_nobreak"><label><input type="radio" name="cloneableonly" value="1" '.$cloneableon.'/> '.&mt('Required').'</label>'.(' 'x3).'<label><input type="radio" name="cloneableonly" value="" '.$cloneableoff.' /> '.&mt('No restriction').'</label></span>'; |
|
if ($formname eq 'ccrs') { |
|
$cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom); |
|
} else { |
|
$cloneabletitle = &mt('Cloneable by you'); |
|
} |
|
} |
|
my $officialjs; |
|
if ($crstype eq 'Course') { |
|
if (exists($filter->{'instcodefilter'})) { |
|
# if (($fixeddom) || ($formname eq 'requestcrs') || |
|
# ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) { |
|
if ($codedom) { |
|
$officialjs = 1; |
|
($instcodeform,$jscript,$$numtitlesref) = |
|
&Apache::courseclassifier::instcode_selectors($codedom,'filterpicker', |
|
$officialjs,$codetitlesref); |
|
if ($jscript) { |
|
$jscript = '<script type="text/javascript">'."\n". |
|
'// <![CDATA['."\n". |
|
$jscript."\n". |
|
'// ]]>'."\n". |
|
'</script>'."\n"; |
|
} |
|
} |
|
if ($instcodeform eq '') { |
|
$instcodeform = |
|
'<input type="text" name="instcodefilter" size="10" value="'. |
|
$list->{'instcodefilter'}.'" />'; |
|
$instcodetitle = $lt{'ins'}; |
|
} else { |
|
$instcodetitle = $lt{'inc'}; |
|
} |
|
if ($fixeddom) { |
|
$instcodetitle .= '<br />('.$codedom.')'; |
|
} |
|
} |
|
} |
|
my $output = qq| |
|
<form method="post" name="filterpicker" action="$action"> |
|
<input type="hidden" name="form" value="$formname" /> |
|
|; |
|
if ($formname eq 'modifycourse') { |
|
$output .= '<input type="hidden" name="phase" value="courselist" />'."\n". |
|
'<input type="hidden" name="prevphase" value="'. |
|
$prevphase.'" />'."\n"; |
|
} elsif ($formname ne 'quotacheck') { |
|
my $name_input; |
|
if ($cnameelement ne '') { |
|
$name_input = '<input type="hidden" name="cnameelement" value="'. |
|
$cnameelement.'" />'; |
|
} |
|
$output .= qq| |
|
<input type="hidden" name="cnumelement" value="$cnumelement" /> |
|
<input type="hidden" name="cdomelement" value="$cdomelement" /> |
|
$name_input |
|
$roleelement |
|
$multelement |
|
$typeelement |
|
|; |
|
if ($formname eq 'portform') { |
|
$output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n"; |
|
} |
|
} |
|
if ($fixeddom) { |
|
$output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n"; |
|
} |
|
$output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box(); |
|
if ($sincefilterform) { |
|
$output .= &Apache::lonhtmlcommon::row_title($lt{'cac'}) |
|
.$sincefilterform |
|
.&Apache::lonhtmlcommon::row_closure(); |
|
} |
|
if ($createdfilterform) { |
|
$output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'}) |
|
.$createdfilterform |
|
.&Apache::lonhtmlcommon::row_closure(); |
|
} |
|
if ($domainselectform) { |
|
$output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'}) |
|
.$domainselectform |
|
.&Apache::lonhtmlcommon::row_closure(); |
|
} |
|
if ($typeselectform) { |
|
if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) { |
|
$output .= $typeselectform; |
|
} else { |
|
$output .= &Apache::lonhtmlcommon::row_title($lt{'cog'}) |
|
.$typeselectform |
|
.&Apache::lonhtmlcommon::row_closure(); |
|
} |
|
} |
|
if ($instcodeform) { |
|
$output .= &Apache::lonhtmlcommon::row_title($instcodetitle) |
|
.$instcodeform |
|
.&Apache::lonhtmlcommon::row_closure(); |
|
} |
|
if (exists($filter->{'ownerfilter'})) { |
|
$output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}). |
|
'<table><tr><td>'.&mt('Username').'<br />'. |
|
'<input type="text" name="ownerfilter" size="20" value="'. |
|
$list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'. |
|
$ownerdomselectform.'</td></tr></table>'. |
|
&Apache::lonhtmlcommon::row_closure(); |
|
} |
|
if (exists($filter->{'personfilter'})) { |
|
$output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}). |
|
'<table><tr><td>'.&mt('Username').'<br />'. |
|
'<input type="text" name="personfilter" size="20" value="'. |
|
$list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'. |
|
$persondomselectform.'</td></tr></table>'. |
|
&Apache::lonhtmlcommon::row_closure(); |
|
} |
|
if (exists($filter->{'coursefilter'})) { |
|
$output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID')) |
|
.'<input type="text" name="coursefilter" size="25" value="' |
|
.$list->{'coursefilter'}.'" />' |
|
.&Apache::lonhtmlcommon::row_closure(); |
|
} |
|
if ($cloneableonlyform) { |
|
$output .= &Apache::lonhtmlcommon::row_title($cloneabletitle). |
|
$cloneableonlyform.&Apache::lonhtmlcommon::row_closure(); |
|
} |
|
if (exists($filter->{'descriptfilter'})) { |
|
$output .= &Apache::lonhtmlcommon::row_title($lt{'cde'}) |
|
.'<input type="text" name="descriptfilter" size="40" value="' |
|
.$list->{'descriptfilter'}.'" />' |
|
.&Apache::lonhtmlcommon::row_closure(1); |
|
} |
|
$output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n". |
|
'<input type="hidden" name="updater" value="" />'."\n". |
|
'<input type="submit" name="gosearch" value="'. |
|
&mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n"; |
|
return $jscript.$clonewarning.$output; |
|
} |
|
|
|
=pod |
|
|
|
=item * &timebased_select_form() |
|
|
|
Create markup for a dropdown list used to select a time-based |
|
filter e.g., Course Activity, Course Created, when searching for courses |
|
or communities |
|
|
|
Inputs: |
|
|
|
item - name of form element (sincefilter or createdfilter) |
|
|
|
filter - anonymous hash of criteria and their values |
|
|
|
Returns: HTML for a select box contained a blank, then six time selections, |
|
with value set in incoming form variables currently selected. |
|
|
|
Side Effects: None |
|
|
|
=cut |
|
|
|
sub timebased_select_form { |
|
my ($item,$filter) = @_; |
|
if (ref($filter) eq 'HASH') { |
|
$filter->{$item} =~ s/[^\d-]//g; |
|
if (!$filter->{$item}) { $filter->{$item}=-1; } |
|
return &select_form( |
|
$filter->{$item}, |
|
$item, |
|
{ '-1' => '', |
|
'86400' => &mt('today'), |
|
'604800' => &mt('last week'), |
|
'2592000' => &mt('last month'), |
|
'7776000' => &mt('last three months'), |
|
'15552000' => &mt('last six months'), |
|
'31104000' => &mt('last year'), |
|
'select_form_order' => |
|
['-1','86400','604800','2592000','7776000', |
|
'15552000','31104000']}); |
|
} |
|
} |
|
|
|
=pod |
|
|
|
=item * &js_changer() |
|
|
|
Create script tag containing Javascript used to submit course search form |
|
when course type or domain is changed, and also to hide 'Searching ...' on |
|
page load completion for page showing search result. |
|
|
|
Inputs: None |
|
|
|
Returns: markup containing updateFilters() and hideSearching() javascript functions. |
|
|
|
Side Effects: None |
|
|
|
=cut |
|
|
|
sub js_changer { |
|
return <<ENDJS; |
|
<script type="text/javascript"> |
|
// <![CDATA[ |
|
function updateFilters(caller) { |
|
if (typeof(caller) != "undefined") { |
|
document.filterpicker.updater.value = caller.name; |
|
} |
|
document.filterpicker.submit(); |
|
} |
|
|
|
function hideSearching() { |
|
if (document.getElementById('searching')) { |
|
document.getElementById('searching').style.display = 'none'; |
|
} |
|
return; |
|
} |
|
|
|
// ]]> |
|
</script> |
|
|
|
ENDJS |
|
} |
|
|
|
=pod |
|
|
|
=item * &search_courses() |
|
|
|
Process selected filters form course search form and pass to lonnet::courseiddump |
|
to retrieve a hash for which keys are courseIDs which match the selected filters. |
|
|
|
Inputs: |
|
|
|
dom - domain being searched |
|
|
|
type - course type ('Course' or 'Community' or '.' if any). |
|
|
|
filter - anonymous hash of criteria and their values |
|
|
|
numtitles - for institutional codes - number of categories |
|
|
|
cloneruname - optional username of new course owner |
|
|
|
clonerudom - optional domain of new course owner |
|
|
|
domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, |
|
(used when DC is using course creation form) |
|
|
|
codetitles - reference to array of titles of components in institutional codes (official courses). |
|
|
|
|
|
Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type. |
|
|
|
|
|
Side Effects: None |
|
|
|
=cut |
|
|
|
|
|
sub search_courses { |
|
my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_; |
|
my (%courses,%showcourses,$cloner); |
|
if (($filter->{'ownerfilter'} ne '') || |
|
($filter->{'ownerdomfilter'} ne '')) { |
|
$filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'. |
|
$filter->{'ownerdomfilter'}; |
|
} |
|
foreach my $item ('descriptfilter','coursefilter','combownerfilter') { |
|
if (!$filter->{$item}) { |
|
$filter->{$item}='.'; |
|
} |
|
} |
|
my $now = time; |
|
my $timefilter = |
|
($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'}); |
|
my ($createdbefore,$createdafter); |
|
if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) { |
|
$createdbefore = $now; |
|
$createdafter = $now-$filter->{'createdfilter'}; |
|
} |
|
my ($instcodefilter,$regexpok); |
|
if ($numtitles) { |
|
if ($env{'form.official'} eq 'on') { |
|
$instcodefilter = |
|
&Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles); |
|
$regexpok = 1; |
|
} elsif ($env{'form.official'} eq 'off') { |
|
$instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles); |
|
unless ($instcodefilter eq '') { |
|
$regexpok = -1; |
|
} |
|
} |
|
} else { |
|
$instcodefilter = $filter->{'instcodefilter'}; |
|
} |
|
if ($instcodefilter eq '') { $instcodefilter = '.'; } |
|
if ($type eq '') { $type = '.'; } |
|
|
|
if (($clonerudom ne '') && ($cloneruname ne '')) { |
|
$cloner = $cloneruname.':'.$clonerudom; |
|
} |
|
%courses = &Apache::lonnet::courseiddump($dom, |
|
$filter->{'descriptfilter'}, |
|
$timefilter, |
|
$instcodefilter, |
|
$filter->{'combownerfilter'}, |
|
$filter->{'coursefilter'}, |
|
undef,undef,$type,$regexpok,undef,undef, |
|
undef,undef,$cloner,$env{'form.cc_clone'}, |
|
$filter->{'cloneableonly'}, |
|
$createdbefore,$createdafter,undef, |
|
$domcloner); |
|
if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) { |
|
my $ccrole; |
|
if ($type eq 'Community') { |
|
$ccrole = 'co'; |
|
} else { |
|
$ccrole = 'cc'; |
|
} |
|
my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'}, |
|
$filter->{'persondomfilter'}, |
|
'userroles',undef, |
|
[$ccrole,'in','ad','ep','ta','cr'], |
|
$dom); |
|
foreach my $role (keys(%rolehash)) { |
|
my ($cnum,$cdom,$courserole) = split(':',$role); |
|
my $cid = $cdom.'_'.$cnum; |
|
if (exists($courses{$cid})) { |
|
if (ref($courses{$cid}) eq 'HASH') { |
|
if (ref($courses{$cid}{roles}) eq 'ARRAY') { |
|
if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) { |
|
push (@{$courses{$cid}{roles}},$courserole); |
|
} |
|
} else { |
|
$courses{$cid}{roles} = [$courserole]; |
|
} |
|
$showcourses{$cid} = $courses{$cid}; |
|
} |
|
} |
|
} |
|
%courses = %showcourses; |
|
} |
|
return %courses; |
|
} |
|
|
|
|
|
=pod |
|
|
|
=back |
|
|
|
=cut |
|
|
|
|
sub build_release_hashes { |
sub build_release_hashes { |
my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_; |
my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_; |
return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') && |
return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') && |
Line 14789 sub captcha_display {
|
Line 15442 sub captcha_display {
|
if ($captcha eq 'original') { |
if ($captcha eq 'original') { |
$output = &create_captcha(); |
$output = &create_captcha(); |
unless ($output) { |
unless ($output) { |
$error = 'captcha'; |
$error = 'captcha'; |
} |
} |
} elsif ($captcha eq 'recaptcha') { |
} elsif ($captcha eq 'recaptcha') { |
$output = &create_recaptcha($pubkey); |
$output = &create_recaptcha($pubkey); |
unless ($output) { |
unless ($output) { |
$error = 'recaptcha'; |
$error = 'recaptcha'; |
} |
} |
} |
} |
return ($output,$error); |
return ($output,$error,$captcha); |
} |
} |
|
|
sub captcha_response { |
sub captcha_response { |
Line 14873 sub create_captcha {
|
Line 15526 sub create_captcha {
|
if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { |
if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { |
$output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n". |
$output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n". |
&mt('Type in the letters/numbers shown below').' '. |
&mt('Type in the letters/numbers shown below').' '. |
'<input type="text" size="5" name="code" value="" /><br />'. |
'<input type="text" size="5" name="code" value="" autocomplete="off" />'. |
'<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />'; |
'<br />'. |
|
'<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />'; |
last; |
last; |
} |
} |
} |
} |
Line 14944 sub check_recaptcha {
|
Line 15598 sub check_recaptcha {
|
return $captcha_chk; |
return $captcha_chk; |
} |
} |
|
|
|
sub emailusername_info { |
|
my @fields = ('firstname','lastname','institution','web','location','officialemail'); |
|
my %titles = &Apache::lonlocal::texthash ( |
|
lastname => 'Last Name', |
|
firstname => 'First Name', |
|
institution => 'School/college/university', |
|
location => "School's city, state/province, country", |
|
web => "School's web address", |
|
officialemail => 'E-mail address at institution (if different)', |
|
); |
|
return (\@fields,\%titles); |
|
} |
|
|
sub cleanup_html { |
sub cleanup_html { |
my ($incoming) = @_; |
my ($incoming) = @_; |
my $outgoing; |
my $outgoing; |
Line 14966 sub cleanup_html {
|
Line 15633 sub cleanup_html {
|
return $outgoing; |
return $outgoing; |
} |
} |
|
|
=pod |
# Use: |
|
# my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver); |
=back |
# |
|
################################################## |
=cut |
# password associated functions # |
|
################################################## |
|
sub des_keys { |
|
# Make a new key for DES encryption. |
|
# Each key has two parts which are returned separately. |
|
# Please note: Each key must be passed through the &hex function |
|
# before it is output to the web browser. The hex versions cannot |
|
# be used to decrypt. |
|
my @hexstr=('0','1','2','3','4','5','6','7', |
|
'8','9','a','b','c','d','e','f'); |
|
my $lkey=''; |
|
for (0..7) { |
|
$lkey.=$hexstr[rand(15)]; |
|
} |
|
my $ukey=''; |
|
for (0..7) { |
|
$ukey.=$hexstr[rand(15)]; |
|
} |
|
return ($lkey,$ukey); |
|
} |
|
|
|
sub des_decrypt { |
|
my ($key,$cyphertext) = @_; |
|
my $keybin=pack("H16",$key); |
|
my $cypher; |
|
if ($Crypt::DES::VERSION>=2.03) { |
|
$cypher=new Crypt::DES $keybin; |
|
} else { |
|
$cypher=new DES $keybin; |
|
} |
|
my $plaintext= |
|
$cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16)))); |
|
$plaintext.= |
|
$cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16)))); |
|
$plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) ); |
|
return $plaintext; |
|
} |
|
|
1; |
1; |
__END__; |
__END__; |