--- loncom/lonnet/perl/lonnet.pm 2021/11/08 03:02:14 1.1470 +++ loncom/lonnet/perl/lonnet.pm 2021/12/24 11:07:43 1.1476 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1470 2021/11/08 03:02:14 raeburn Exp $ +# $Id: lonnet.pm,v 1.1476 2021/12/24 11:07:43 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2666,6 +2666,7 @@ sub get_domain_defaults { if (ref($domconfig{'coursedefaults'}) eq 'HASH') { $domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'}; $domdefaults{'usejsme'} = $domconfig{'coursedefaults'}{'usejsme'}; + $domdefaults{'inline_chem'} = $domconfig{'coursedefaults'}{'inline_chem'}; $domdefaults{'uselcmath'} = $domconfig{'coursedefaults'}{'uselcmath'}; if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') { $domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'}; @@ -4659,7 +4660,7 @@ sub bubblesheet_converter { next if (($num == 1) && ($csvoptions{'hdr'} == 1)); $line =~ s{[\r\n]+$}{}; my %found; - my @values = split(/,/,$line); + my @values = split(/,/,$line,-1); my ($qstart,$record); for (my $i=0; $i<@values; $i++) { if ((($qstart ne '') && ($i > $qstart)) || @@ -4963,6 +4964,29 @@ sub flushcourselogs { if (! defined($dom) || $dom eq '' || ! defined($name) || $name eq '') { my $cid = $env{'request.course.id'}; +# +# FIXME 11/29/2021 +# Typo in rev. 1.458 (2003/12/09)?? +# These should likely by $env{'course.'.$cid.'.domain'} and $env{'course.'.$cid.'.num'} +# +# While these ramain as $env{'request.'.$cid.'.domain'} and $env{'request.'.$cid.'.num'} +# $dom and $name will always be null, so the &inc() call will default to storing this data +# in a nohist_accesscount.db file for the user rather than the course. +# +# That said there is a lot of noise in the data being stored. +# So counts for prtspool/ and adm/ etc. are recorded. +# +# A review of which items ending '___count' are written to %accesshash should likely be +# made before deciding whether to set these to 'course.' instead of 'request.' +# +# Under the current scheme each user receives a nohist_accesscount.db file listing +# accesses for things which are not published resources, regardless of course, and +# there is not a nohist_accesscount.db file in a course, which might log accesses from +# anyone in the course for things which are not published resources. +# +# For an author, nohist_accesscount.db ends up having records for other items +# mixed up with the legitimate access counts for the author's published resources. +# $dom = $env{'request.'.$cid.'.domain'}; $name = $env{'request.'.$cid.'.num'}; } @@ -7560,15 +7584,15 @@ sub portfolio_access { if ($result) { my %setters; if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') { - my ($startblock,$endblock) = - &Apache::loncommon::blockcheck(\%setters,'port',$unum,$udom); - if ($startblock && $endblock) { + my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = + &Apache::loncommon::blockcheck(\%setters,'port',$clientip,$unum,$udom); + if (($startblock && $endblock) || ($by_ip)) { return 'B'; } } else { - my ($startblock,$endblock) = - &Apache::loncommon::blockcheck(\%setters,'port'); - if ($startblock && $endblock) { + my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = + &Apache::loncommon::blockcheck(\%setters,'port',$clientip); + if (($startblock && $endblock) || ($by_ip)) { return 'B'; } } @@ -8151,9 +8175,9 @@ sub allowed { if (($space=~/^(uploaded|editupload)$/) && ($env{'user.name'} eq $name) && ($env{'user.domain'} eq $domain) && ('portfolio' eq $dir[0])) { my %setters; - my ($startblock,$endblock) = - &Apache::loncommon::blockcheck(\%setters,'port'); - if ($startblock && $endblock) { + my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = + &Apache::loncommon::blockcheck(\%setters,'port',$clientip); + if (($startblock && $endblock) || ($by_ip)) { return 'B'; } else { return 'F'; @@ -8891,10 +8915,9 @@ sub get_commblock_resources { } } elsif ($block =~ /^firstaccess____(.+)$/) { my $item = $1; - my @to_test; if (ref($commblocks{$block}{'blocks'}) eq 'HASH') { if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') { - my @interval; + my (@interval,$mapname); my $type = 'map'; if ($item eq 'course') { $type = 'course'; @@ -8903,36 +8926,11 @@ sub get_commblock_resources { if ($item =~ /___\d+___/) { $type = 'resource'; @interval=&EXT("resource.0.interval",$item); - if (ref($navmap)) { - my $res = $navmap->getBySymb($item); - push(@to_test,$res); - } } else { - my $mapsymb = &symbread($item,1); - if ($mapsymb) { - if (ref($navmap)) { - my $mapres = $navmap->getBySymb($mapsymb); - if (ref($mapres)) { - my $first = $mapres->map_start(); - my $finish = $mapres->map_finish(); - my $it = $navmap->getIterator($first,$finish,undef,0,0); - if (ref($it)) { - my $res; - while ($res = $it->next(undef,1)) { - next unless (ref($res)); - my $symb = $res->symb(); - next if (($symb eq $mapsymb) || ($symb eq '')); - @interval=&EXT("resource.0.interval",$symb); - if ($interval[1] eq 'map') { - if ($res->answerable()) { - push(@to_test,$res); - last; - } - } - } - } - } - } + $mapname = &deversion($item); + if (ref($navmap)) { + my $timelimit = $navmap->get_mapparam(undef,$mapname,'0.interval'); + @interval = ($timelimit,'map'); } } } @@ -8950,10 +8948,37 @@ sub get_commblock_resources { my $timesup = $first_access+$timelimit; if ($timesup > $now) { my $activeblock; - foreach my $res (@to_test) { - if ($res->answerable()) { - $activeblock = 1; - last; + if ($type eq 'resource') { + if (ref($navmap)) { + my $res = $navmap->getBySymb($item); + if ($res->answerable()) { + $activeblock = 1; + } + } + } elsif ($type eq 'map') { + my $mapsymb = &symbread($mapname,1); + if (($mapsymb) && (ref($navmap))) { + my $mapres = $navmap->getBySymb($mapsymb); + if (ref($mapres)) { + my $first = $mapres->map_start(); + my $finish = $mapres->map_finish(); + my $it = $navmap->getIterator($first,$finish,undef,0,0); + if (ref($it)) { + my $res; + while ($res = $it->next(undef,1)) { + next unless (ref($res)); + my $symb = $res->symb(); + next if (($symb eq $mapsymb) || ($symb eq '')); + @interval=&EXT("resource.0.interval",$symb); + if ($interval[1] eq 'map') { + if ($res->answerable()) { + $activeblock = 1; + last; + } + } + } + } + } } } if ($activeblock) { @@ -9387,7 +9412,7 @@ sub fetch_enrollment_query { } sub get_query_reply { - my ($queryid,$sleep,$loopmax) = @_;; + my ($queryid,$sleep,$loopmax) = @_; if (($sleep eq '') || ($sleep !~ /^\d+\.?\d*$/)) { $sleep = 0.2; } @@ -14632,7 +14657,7 @@ sub use_proxy_alias { return; } -sub alias_shibboleth { +sub alias_sso { my ($lonid) = @_; if ($lonid eq '') { $lonid = $perlvar{'lonHostID'};