'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
- $count,''.
- $fname.' ').'
';
- } else {
- $output .= ''.
- &mt('Error: could not update links in [_1].',
- ''.
- $container.' ').'
';
-
- }
- }
- }
- }
} else {
&logthis('Failed to parse '.$container.
' to modify references: '.$parse_result);
@@ -11000,43 +10350,16 @@ sub decompress_form {
}
}
if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
- my @camtasia6 = ("$topdir/","$topdir/index.html",
+ my @camtasia = ("$topdir/","$topdir/index.html",
"$topdir/media/",
"$topdir/media/$topdir.mp4",
"$topdir/media/FirstFrame.png",
"$topdir/media/player.swf",
"$topdir/media/swfobject.js",
"$topdir/media/expressInstall.swf");
- my @camtasia8 = ("$topdir/","$topdir/$topdir.html",
- "$topdir/$topdir.mp4",
- "$topdir/$topdir\_config.xml",
- "$topdir/$topdir\_controller.swf",
- "$topdir/$topdir\_embed.css",
- "$topdir/$topdir\_First_Frame.png",
- "$topdir/$topdir\_player.html",
- "$topdir/$topdir\_Thumbnails.png",
- "$topdir/playerProductInstall.swf",
- "$topdir/scripts/",
- "$topdir/scripts/config_xml.js",
- "$topdir/scripts/handlebars.js",
- "$topdir/scripts/jquery-1.7.1.min.js",
- "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
- "$topdir/scripts/modernizr.js",
- "$topdir/scripts/player-min.js",
- "$topdir/scripts/swfobject.js",
- "$topdir/skins/",
- "$topdir/skins/configuration_express.xml",
- "$topdir/skins/express_show/",
- "$topdir/skins/express_show/player-min.css",
- "$topdir/skins/express_show/spritesheet.png");
- my @diffs = &compare_arrays(\@paths,\@camtasia6);
+ my @diffs = &compare_arrays(\@paths,\@camtasia);
if (@diffs == 0) {
- $is_camtasia = 6;
- } else {
- @diffs = &compare_arrays(\@paths,\@camtasia8);
- if (@diffs == 0) {
- $is_camtasia = 8;
- }
+ $is_camtasia = 1;
}
}
my $output;
@@ -11048,7 +10371,8 @@ sub decompress_form {
function camtasiaToggle() {
for (var i=0; i'."\n";
@@ -11925,7 +11241,7 @@ sub process_extracted_files {
my ($outtext,$errtext)=
&LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
$docuname.'/'.$folders{$outer}.
- '.'.$containers{$outer},1,1);
+ '.'.$containers{$outer},1);
unless ($errtext) {
if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
$result .= ''.&mt('File: [_1] added to course',$docstitle).' '."\n";
@@ -11933,93 +11249,87 @@ sub process_extracted_files {
}
}
}
- }
- } else {
- $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).' ';
- }
- }
- for (my $i=1; $i<=$numitems; $i++) {
- next unless ($env{'form.archive_'.$i} eq 'dependency');
- my $path = $env{'form.archive_content_'.$i};
- if ($path =~ /^\Q$pathtocheck\E/) {
- my ($title) = ($path =~ m{/([^/]+)$});
- $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
- if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
- if (ref($dirorder{$i}) eq 'ARRAY') {
- my ($itemidx,$fullpath,$relpath);
- if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
- my $container = $dirorder{$referrer{$i}}->[-1];
+ } elsif ($env{'form.archive_'.$i} eq 'dependency') {
+ my ($title) = ($path =~ m{/([^/]+)$});
+ $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
+ if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
+ if (ref($dirorder{$i}) eq 'ARRAY') {
+ my ($itemidx,$fullpath,$relpath);
for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
- if ($dirorder{$i}->[$j] eq $container) {
- $itemidx = $j;
+ if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
+ my $container = $dirorder{$referrer{$i}}->[-1];
+ for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
+ if ($dirorder{$i}->[$j] eq $container) {
+ $itemidx = $j;
+ }
+ }
}
}
- }
- if ($itemidx eq '') {
- $itemidx = 0;
- }
- if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
- if ($mapinner{$referrer{$i}}) {
- $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
- for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
- if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
- unless (defined($newseqid{$dirorder{$i}->[$j]})) {
- $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
- $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
- if (!-e $fullpath) {
- mkdir($fullpath,0755);
+ if ($itemidx ne '') {
+ if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
+ if ($mapinner{$referrer{$i}}) {
+ $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
+ for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
+ if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
+ unless (defined($newseqid{$dirorder{$i}->[$j]})) {
+ $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
+ $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
+ if (!-e $fullpath) {
+ mkdir($fullpath,0755);
+ }
+ }
+ } else {
+ last;
}
}
- } else {
- last;
}
- }
- }
- } elsif ($newdest{$referrer{$i}}) {
- $fullpath = $newdest{$referrer{$i}};
- for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
- if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
- $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
- last;
- } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
- unless (defined($newseqid{$dirorder{$i}->[$j]})) {
- $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
- $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
- if (!-e $fullpath) {
- mkdir($fullpath,0755);
+ } elsif ($newdest{$referrer{$i}}) {
+ $fullpath = $newdest{$referrer{$i}};
+ for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
+ if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
+ $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
+ last;
+ } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
+ unless (defined($newseqid{$dirorder{$i}->[$j]})) {
+ $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
+ $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
+ if (!-e $fullpath) {
+ mkdir($fullpath,0755);
+ }
+ }
+ } else {
+ last;
}
}
- } else {
- last;
}
- }
- }
- if ($fullpath ne '') {
- if (-e "$prefix$path") {
- system("mv $prefix$path $fullpath/$title");
- }
- if (-e "$fullpath/$title") {
- my $showpath;
- if ($relpath ne '') {
- $showpath = "$relpath/$title";
- } else {
- $showpath = "/$title";
+ if ($fullpath ne '') {
+ if (-e "$prefix$path") {
+ system("mv $prefix$path $fullpath/$title");
+ }
+ if (-e "$fullpath/$title") {
+ my $showpath;
+ if ($relpath ne '') {
+ $showpath = "$relpath/$title";
+ } else {
+ $showpath = "/$title";
+ }
+ $result .= ''.&mt('[_1] included as a dependency',$showpath).' '."\n";
+ }
+ unless ($ishome) {
+ my $fetch = "$fullpath/$title";
+ $fetch =~ s/^\Q$prefix$dir\E//;
+ $prompttofetch{$fetch} = 1;
+ }
}
- $result .= ''.&mt('[_1] included as a dependency',$showpath).' '."\n";
- }
- unless ($ishome) {
- my $fetch = "$fullpath/$title";
- $fetch =~ s/^\Q$prefix$dir\E//;
- $prompttofetch{$fetch} = 1;
}
}
+ } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
+ $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
+ $path,$env{'form.archive_content_'.$referrer{$i}}).' ';
}
- } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
- $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
- $path,$env{'form.archive_content_'.$referrer{$i}}).' ';
}
} else {
- $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).' ';
+ $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).' ';
}
}
if (keys(%todelete)) {
@@ -12078,7 +11388,7 @@ sub cleanup_empty_dirs {
my $numitems = 0;
foreach my $item (@dircontents) {
if (-d "$path/$item") {
- &cleanup_empty_dirs("$path/$item");
+ &recurse_dirs("$path/$item");
if (-e "$path/$item") {
$numitems ++;
}
@@ -12097,7 +11407,7 @@ sub cleanup_empty_dirs {
=pod
-=item * &get_folder_hierarchy()
+=item &get_folder_hierarchy()
Provides hierarchy of names of folders/sub-folders containing the current
item,
@@ -12125,7 +11435,7 @@ sub get_folder_hierarchy {
my @pcs = split(/,/,$pcslist);
foreach my $pc (@pcs) {
if ($pc == 1) {
- push(@pathitems,&mt('Main Content'));
+ push(@pathitems,&mt('Main Course Documents'));
} else {
my $res = $navmap->getByMapPc($pc);
if (ref($res)) {
@@ -12140,7 +11450,7 @@ sub get_folder_hierarchy {
}
if ($showitem) {
if ($mapres->{ID} eq '0.0') {
- push(@pathitems,&mt('Main Content'));
+ push(@pathitems,&mt('Main Course Documents'));
} else {
my $maptitle = $mapres->compTitle();
$maptitle =~ s/\W+/_/g;
@@ -12207,9 +11517,6 @@ sub get_turnedin_filepath {
my $title = $res->compTitle();
$title =~ s/\W+/_/g;
if ($title ne '') {
- if (($pc > 1) && (length($title) > 12)) {
- $title = substr($title,0,12);
- }
push(@pathitems,$title);
}
}
@@ -12218,9 +11525,6 @@ sub get_turnedin_filepath {
my $maptitle = $mapres->compTitle();
$maptitle =~ s/\W+/_/g;
if ($maptitle ne '') {
- if (length($maptitle) > 12) {
- $maptitle = substr($maptitle,0,12);
- }
push(@pathitems,$maptitle);
}
unless ($env{'request.state'} eq 'construct') {
@@ -12261,9 +11565,6 @@ sub get_turnedin_filepath {
$restitle = time;
}
}
- if (length($restitle) > 12) {
- $restitle = substr($restitle,0,12);
- }
push(@pathitems,$restitle);
$path .= join('/',@pathitems);
}
@@ -13201,22 +12502,18 @@ sub restore_settings {
=item * &build_recipient_list()
-Build recipient lists for following types of e-mail:
+Build recipient lists for five types of e-mail:
(a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
-(d) Help requests, (e) Course requests needing approval, (f) loncapa
-module change checking, student/employee ID conflict checks, as
-generated by lonerrorhandler.pm, CHECKRPMS, loncron,
-lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
+(d) Help requests, (e) Course requests needing approval, generated by
+lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
+loncoursequeueadmin.pm respectively.
Inputs:
-defmail (scalar - email address of default recipient),
-mailing type (scalar: errormail, packagesmail, helpdeskmail,
-requestsmail, updatesmail, or idconflictsmail).
-
+defmail (scalar - email address of default recipient),
+mailing type (scalar - errormail, packagesmail, or helpdeskmail),
defdom (domain for which to retrieve configuration settings),
-
-origmail (scalar - email address of recipient from loncapa.conf,
-i.e., predates configuration by DC via domainprefs.pm
+origmail (scalar - email address of recipient from loncapa.conf,
+i.e., predates configuration by DC via domainprefs.pm
Returns: comma separated list of addresses to which to send e-mail.
@@ -13410,7 +12707,7 @@ sub extract_categories {
=pod
-=item * &recurse_categories()
+=item *&recurse_categories()
Recursively used to generate breadcrumb trails for course categories.
@@ -13481,7 +12778,7 @@ sub recurse_categories {
=pod
-=item * &assign_categories_table()
+=item *&assign_categories_table()
Create a datatable for display of hierarchical categories in a domain,
with checkboxes to allow a course to be categorized.
@@ -13558,7 +12855,7 @@ sub assign_categories_table {
=pod
-=item * &assign_category_rows()
+=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.
@@ -13592,7 +12889,7 @@ sub assign_category_rows {
if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
my $numchildren = @{$cats->[$depth]{$parent}};
my $css_class = $itemcount%2?' class="LC_odd_row"':'';
- $text .= '';
+ $text .= '';
for (my $j=0; $j<$numchildren; $j++) {
$name = $cats->[$depth]{$parent}[$j];
$item = &escape($name).':'.&escape($parent).':'.$depth;
@@ -13640,7 +12937,7 @@ sub commit_customrole {
}
sub commit_standardrole {
- my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
+ my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
my ($output,$logmsg,$linefeed);
if ($context eq 'auto') {
$linefeed = "\n";
@@ -13649,7 +12946,7 @@ sub commit_standardrole {
}
if ($three eq 'st') {
my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
- $one,$two,$sec,$context,$credits);
+ $one,$two,$sec,$context);
if (($result =~ /^error/) || ($result eq 'not_in_class') ||
($result eq 'unknown_course') || ($result eq 'refused')) {
$output = $logmsg.' '.&mt('Error: ').$result."\n";
@@ -13680,8 +12977,7 @@ sub commit_standardrole {
}
sub commit_studentrole {
- my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
- $credits) = @_;
+ my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
my ($result,$linefeed,$oldsecurl,$newsecurl);
if ($context eq 'auto') {
$linefeed = "\n";
@@ -13728,11 +13024,7 @@ sub commit_studentrole {
}
}
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,
- '',$context,$credits);
+ $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 ($secchange == 1) {
if ($sec eq '') {
@@ -13763,7 +13055,7 @@ sub commit_studentrole {
$result = $modify_section_result;
} elsif ($secchange == 1) {
if ($oldsec eq '') {
- $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_2] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
+ $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
} else {
$$logmsg .= &mt('Error when attempting to expire existing role for [_1] in section [_2] in course [_3] -error: ',$uname,$oldsec,$cid).' '.$expire_role_result.$linefeed;
}
@@ -13789,26 +13081,6 @@ sub commit_studentrole {
return $result;
}
-sub show_role_extent {
- my ($scope,$context,$role) = @_;
- $scope =~ s{^/}{};
- my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
- push(@courseroles,'co');
- my @authorroles = &Apache::lonuserutils::roles_by_context('author');
- if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
- $scope =~ s{/}{_};
- return ''.$env{'course.'.$scope.'.description'}.' ';
- } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
- my ($audom,$auname) = split(/\//,$scope);
- return &mt('[_1] Author Space',''.
- &Apache::loncommon::plainname($auname,$audom).' ');
- } else {
- $scope =~ s{/$}{};
- return &mt('Domain: [_1]',''.
- &Apache::lonnet::domain($scope,'description').' ');
- }
-}
-
############################################################
############################################################
@@ -13876,7 +13148,7 @@ sub check_clone {
}
sub construct_course {
- my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
+ my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
my $outcome;
my $linefeed = ' '."\n";
if ($context eq 'auto') {
@@ -13972,9 +13244,7 @@ sub construct_course {
'pch.users.denied',
'plc.users.denied',
'hidefromcat',
- 'checkforpriv',
- 'categories',
- 'internal.uniquecode'],
+ 'categories'],
$$crsudom,$$crsunum);
}
@@ -14003,9 +13273,6 @@ sub construct_course {
} else {
$cenv{'internal.courseowner'} = $args->{'curruser'};
}
- if ($args->{'defaultcredits'}) {
- $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
- }
my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
if ($args->{'crssections'}) {
$cenv{'internal.sectionnums'} = '';
@@ -14030,11 +13297,6 @@ sub construct_course {
# do not hide course coordinator from staff listing,
# even if privileged
$cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
-# add course coordinator's domain to domains to check for privileged users
-# if different to course domain
- if ($$crsudom ne $args->{'ccdomain'}) {
- $cenv{'checkforpriv'} = $args->{'ccdomain'};
- }
# add crosslistings
if ($args->{'crsxlist'}) {
$cenv{'internal.crosslistings'}='';
@@ -14159,25 +13421,6 @@ 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'}) {
$cenv{'pch.roles.denied'}='st';
}
@@ -14246,60 +13489,6 @@ sub construct_course {
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;
-}
-
############################################################
############################################################
@@ -14327,12 +13516,11 @@ sub group_term {
}
sub course_types {
- my @types = ('official','unofficial','community','textbook');
+ my @types = ('official','unofficial','community');
my %typename = (
official => 'Official course',
unofficial => 'Unofficial course',
community => 'Community',
- textbook => 'Textbook course',
);
return (\@types,\%typename);
}
@@ -14465,7 +13653,7 @@ sub init_user_environment {
# ------------------------------------ Check browser type and MathML capability
my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
- $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);
+ $clientunicode,$clientos) = &decode_user_agent($r);
# ------------------------------------------------------------- Get environment
@@ -14496,8 +13684,6 @@ sub init_user_environment {
"browser.mathml" => $clientmathml,
"browser.unicode" => $clientunicode,
"browser.os" => $clientos,
- "browser.mobile" => $clientmobile,
- "browser.info" => $clientinfo,
"server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
"request.course.fn" => '',
"request.course.uri" => '',
@@ -14517,45 +13703,25 @@ sub init_user_environment {
$env{'browser.interface'}=$form->{'interface'};
}
- if ($form->{'iptoken'}) {
- my $lonhost = $r->dir_config('lonHostID');
- $initial_env{"user.noloadbalance"} = $lonhost;
- $env{'user.noloadbalance'} = $lonhost;
- }
-
my %is_adv = ( is_adv => $env{'user.adv'} );
my %domdef;
unless ($domain eq 'public') {
%domdef = &Apache::lonnet::get_domain_defaults($domain);
}
- foreach my $tool ('aboutme','blog','webdav','portfolio') {
+ foreach my $tool ('aboutme','blog','portfolio') {
$userenv{'availabletools.'.$tool} =
&Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
undef,\%userenv,\%domdef,\%is_adv);
}
- foreach my $crstype ('official','unofficial','community','textbook') {
+ foreach my $crstype ('official','unofficial','community') {
$userenv{'canrequest.'.$crstype} =
&Apache::lonnet::usertools_access($username,$domain,$crstype,
'reload','requestcourses',
\%userenv,\%domdef,\%is_adv);
}
- $userenv{'canrequest.author'} =
- &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
- 'reload','requestauthor',
- \%userenv,\%domdef,\%is_adv);
- my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
- $domain,$username);
- my $reqstatus = $reqauthor{'author_status'};
- if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
- if (ref($reqauthor{'author'}) eq 'HASH') {
- $userenv{'requestauthorqueued'} = $reqstatus.':'.
- $reqauthor{'author'}{'timestamp'};
- }
- }
-
$env{'user.environment'} = "$lonids/$cookie.id";
if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
@@ -14670,368 +13836,6 @@ sub build_release_hashes {
return;
}
-sub update_content_constraints {
- my ($cdom,$cnum,$chome,$cid) = @_;
- my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
- my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
- my %checkresponsetypes;
- foreach my $key (keys(%Apache::lonnet::needsrelease)) {
- my ($item,$name,$value) = split(/:/,$key);
- if ($item eq 'resourcetag') {
- if ($name eq 'responsetype') {
- $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
- }
- }
- }
- my $navmap = Apache::lonnavmaps::navmap->new();
- if (defined($navmap)) {
- my %allresponses;
- foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
- my %responses = $res->responseTypes();
- foreach my $key (keys(%responses)) {
- next unless(exists($checkresponsetypes{$key}));
- $allresponses{$key} += $responses{$key};
- }
- }
- foreach my $key (keys(%allresponses)) {
- my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
- if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
- ($reqdmajor,$reqdminor) = ($major,$minor);
- }
- }
- undef($navmap);
- }
- unless (($reqdmajor eq '') && ($reqdminor eq '')) {
- &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
- }
- return;
-}
-
-sub allmaps_incourse {
- my ($cdom,$cnum,$chome,$cid) = @_;
- if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
- $cid = $env{'request.course.id'};
- $cdom = $env{'course.'.$cid.'.domain'};
- $cnum = $env{'course.'.$cid.'.num'};
- $chome = $env{'course.'.$cid.'.home'};
- }
- my %allmaps = ();
- my $lastchange =
- &Apache::lonnet::get_coursechange($cdom,$cnum);
- if ($lastchange > $env{'request.course.tied'}) {
- my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
- unless ($ferr) {
- &update_content_constraints($cdom,$cnum,$chome,$cid);
- }
- }
- my $navmap = Apache::lonnavmaps::navmap->new();
- if (defined($navmap)) {
- foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
- $allmaps{$res->src()} = 1;
- }
- }
- return \%allmaps;
-}
-
-sub parse_supplemental_title {
- my ($title) = @_;
-
- my ($foldertitle,$renametitle);
- if ($title =~ /&&&/) {
- $title = &HTML::Entites::decode($title);
- }
- if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
- $renametitle=$4;
- my ($time,$uname,$udom) = ($1,$2,$3);
- $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
- my $name = &plainname($uname,$udom);
- $name = &HTML::Entities::encode($name,'"<>&\'');
- $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
- $title=''.&Apache::lonlocal::locallocaltime($time).' '.
- $name.': '.$foldertitle;
- }
- if (wantarray) {
- return ($title,$foldertitle,$renametitle);
- }
- return $title;
-}
-
-sub recurse_supplemental {
- my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
- if ($suppmap) {
- my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
- if ($fatal) {
- $errors ++;
- } else {
- if ($#LONCAPA::map::resources > 0) {
- foreach my $res (@LONCAPA::map::resources) {
- my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
- if (($src ne '') && ($status eq 'res')) {
- if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
- ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
- } else {
- $numfiles ++;
- }
- }
- }
- }
- }
- }
- return ($numfiles,$errors);
-}
-
-sub symb_to_docspath {
- my ($symb) = @_;
- return unless ($symb);
- my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
- if ($resurl=~/\.(sequence|page)$/) {
- $mapurl=$resurl;
- } elsif ($resurl eq 'adm/navmaps') {
- $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
- }
- my $mapresobj;
- my $navmap = Apache::lonnavmaps::navmap->new();
- if (ref($navmap)) {
- $mapresobj = $navmap->getResourceByUrl($mapurl);
- }
- $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
- my $type=$2;
- my $path;
- if (ref($mapresobj)) {
- my $pcslist = $mapresobj->map_hierarchy();
- if ($pcslist ne '') {
- foreach my $pc (split(/,/,$pcslist)) {
- next if ($pc <= 1);
- my $res = $navmap->getByMapPc($pc);
- if (ref($res)) {
- my $thisurl = $res->src();
- $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
- my $thistitle = $res->title();
- $path .= '&'.
- &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
- &escape($thistitle).
- ':'.$res->randompick().
- ':'.$res->randomout().
- ':'.$res->encrypted().
- ':'.$res->randomorder().
- ':'.$res->is_page();
- }
- }
- }
- $path =~ s/^\&//;
- my $maptitle = $mapresobj->title();
- if ($mapurl eq 'default') {
- $maptitle = 'Main Content';
- }
- $path .= (($path ne '')? '&' : '').
- &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
- &escape($maptitle).
- ':'.$mapresobj->randompick().
- ':'.$mapresobj->randomout().
- ':'.$mapresobj->encrypted().
- ':'.$mapresobj->randomorder().
- ':'.$mapresobj->is_page();
- } else {
- my $maptitle = &Apache::lonnet::gettitle($mapurl);
- my $ispage = (($type eq 'page')? 1 : '');
- if ($mapurl eq 'default') {
- $maptitle = 'Main Content';
- }
- $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
- &escape($maptitle).':::::'.$ispage;
- }
- unless ($mapurl eq 'default') {
- $path = 'default&'.
- &escape('Main Content').
- ':::::&'.$path;
- }
- return $path;
-}
-
-sub captcha_display {
- my ($context,$lonhost) = @_;
- my ($output,$error);
- my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
- if ($captcha eq 'original') {
- $output = &create_captcha();
- unless ($output) {
- $error = 'captcha';
- }
- } elsif ($captcha eq 'recaptcha') {
- $output = &create_recaptcha($pubkey);
- unless ($output) {
- $error = 'recaptcha';
- }
- }
- return ($output,$error);
-}
-
-sub captcha_response {
- my ($context,$lonhost) = @_;
- my ($captcha_chk,$captcha_error);
- my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
- if ($captcha eq 'original') {
- ($captcha_chk,$captcha_error) = &check_captcha();
- } elsif ($captcha eq 'recaptcha') {
- $captcha_chk = &check_recaptcha($privkey);
- } else {
- $captcha_chk = 1;
- }
- return ($captcha_chk,$captcha_error);
-}
-
-sub get_captcha_config {
- my ($context,$lonhost) = @_;
- my ($captcha,$pubkey,$privkey,$hashtocheck);
- my $hostname = &Apache::lonnet::hostname($lonhost);
- my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
- my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
- if ($context eq 'usercreation') {
- my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
- if (ref($domconfig{$context}) eq 'HASH') {
- $hashtocheck = $domconfig{$context}{'cancreate'};
- if (ref($hashtocheck) eq 'HASH') {
- if ($hashtocheck->{'captcha'} eq 'recaptcha') {
- if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
- $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
- $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
- }
- if ($privkey && $pubkey) {
- $captcha = 'recaptcha';
- } else {
- $captcha = 'original';
- }
- } elsif ($hashtocheck->{'captcha'} ne 'notused') {
- $captcha = 'original';
- }
- }
- } else {
- $captcha = 'captcha';
- }
- } elsif ($context eq 'login') {
- my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
- if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
- $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
- $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
- if ($privkey && $pubkey) {
- $captcha = 'recaptcha';
- } else {
- $captcha = 'original';
- }
- } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
- $captcha = 'original';
- }
- }
- return ($captcha,$pubkey,$privkey);
-}
-
-sub create_captcha {
- my %captcha_params = &captcha_settings();
- my ($output,$maxtries,$tries) = ('',10,0);
- while ($tries < $maxtries) {
- $tries ++;
- my $captcha = Authen::Captcha->new (
- output_folder => $captcha_params{'output_dir'},
- data_folder => $captcha_params{'db_dir'},
- );
- my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
-
- if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
- $output = ' '."\n".
- &mt('Type in the letters/numbers shown below').' '.
- ' '.
- ' ';
- last;
- }
- }
- return $output;
-}
-
-sub captcha_settings {
- my %captcha_params = (
- output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
- www_output_dir => "/captchaspool",
- db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
- numchars => '5',
- );
- return %captcha_params;
-}
-
-sub check_captcha {
- my ($captcha_chk,$captcha_error);
- my $code = $env{'form.code'};
- my $md5sum = $env{'form.crypt'};
- my %captcha_params = &captcha_settings();
- my $captcha = Authen::Captcha->new(
- output_folder => $captcha_params{'output_dir'},
- data_folder => $captcha_params{'db_dir'},
- );
- $captcha_chk = $captcha->check_code($code,$md5sum);
- my %captcha_hash = (
- 0 => 'Code not checked (file error)',
- -1 => 'Failed: code expired',
- -2 => 'Failed: invalid code (not in database)',
- -3 => 'Failed: invalid code (code does not match crypt)',
- );
- if ($captcha_chk != 1) {
- $captcha_error = $captcha_hash{$captcha_chk}
- }
- return ($captcha_chk,$captcha_error);
-}
-
-sub create_recaptcha {
- my ($pubkey) = @_;
- my $use_ssl;
- if ($ENV{'SERVER_PORT'} == 443) {
- $use_ssl = 1;
- }
- my $captcha = Captcha::reCAPTCHA->new;
- return $captcha->get_options_setter({theme => 'white'})."\n".
- $captcha->get_html($pubkey,undef,$use_ssl).
- &mt('If either word is hard to read, [_1] will replace them.',
- ' ').
- ' ';
-}
-
-sub check_recaptcha {
- my ($privkey) = @_;
- my $captcha_chk;
- my $captcha = Captcha::reCAPTCHA->new;
- my $captcha_result =
- $captcha->check_answer(
- $privkey,
- $ENV{'REMOTE_ADDR'},
- $env{'form.recaptcha_challenge_field'},
- $env{'form.recaptcha_response_field'},
- );
- if ($captcha_result->{is_valid}) {
- $captcha_chk = 1;
- }
- return $captcha_chk;
-}
-
-sub cleanup_html {
- my ($incoming) = @_;
- my $outgoing;
- if ($incoming ne '') {
- $outgoing = $incoming;
- $outgoing =~ s/;/;/g;
- $outgoing =~ s/\#/#/g;
- $outgoing =~ s/\&/&/g;
- $outgoing =~ s/</g;
- $outgoing =~ s/>/>/g;
- $outgoing =~ s/\(/(/g;
- $outgoing =~ s/\)/)/g;
- $outgoing =~ s/"/"/g;
- $outgoing =~ s/'/'/g;
- $outgoing =~ s/\$/$/g;
- $outgoing =~ s{/}{/}g;
- $outgoing =~ s/=/=/g;
- $outgoing =~ s/\\/\/g
- }
- return $outgoing;
-}
-
=pod
=back