--- loncom/lonnet/perl/lonnet.pm 2014/01/01 17:41:42 1.1247 +++ loncom/lonnet/perl/lonnet.pm 2014/02/23 20:53:03 1.1250 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1247 2014/01/01 17:41:42 raeburn Exp $ +# $Id: lonnet.pm,v 1.1250 2014/02/23 20:53:03 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -676,7 +676,7 @@ sub appenv { if (($key =~ /^user\.role/) || ($key =~ /^user\.priv/)) { $refused = 1; if (ref($roles) eq 'ARRAY') { - my ($type,$role) = ($key =~ /^user\.(role|priv)\.([^.]+)\./); + my ($type,$role) = ($key =~ m{^user\.(role|priv)\.(.+?)\./}); if (grep(/^\Q$role\E$/,@{$roles})) { $refused = 0; } @@ -5214,7 +5214,7 @@ sub set_arearole { sub custom_roleprivs { my ($allroles,$trole,$tdomain,$trest,$spec,$area) = @_; my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole); - my $homsvr=homeserver($rauthor,$rdomain); + my $homsvr = &homeserver($rauthor,$rdomain); if (&hostname($homsvr) ne '') { my ($rdummy,$roledef)= &get('roles',["rolesdef_$rrole"],$rdomain,$rauthor); @@ -5335,11 +5335,11 @@ sub set_userprivs { sub role_status { my ($rolekey,$update,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_; - my @pwhere = (); if (exists($env{$rolekey}) && $env{$rolekey} ne '') { - (undef,undef,$$role,@pwhere)=split(/\./,$rolekey); + my ($one,$two) = split(m{\./},$rolekey,2); + (undef,undef,$$role) = split(/\./,$one,3); + $$where = '/'.$two; unless (!defined($$role) || $$role eq '') { - $$where=join('.',@pwhere); $$trolecode=$$role.'.'.$$where; ($$tstart,$$tend)=split(/\./,$env{$rolekey}); $$tstatus='is'; @@ -6736,7 +6736,7 @@ sub allowed { && &is_portfolio_url($uri)) { $thisallowed = &portfolio_access($uri); } - + # Full access at system, domain or course-wide level? Exit. if ($thisallowed=~/F/) { return 'F'; @@ -7851,6 +7851,33 @@ sub auto_validate_class_sec { return $response; } +sub auto_crsreq_update { + my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title, + $code,$inbound) = @_; + my ($homeserver,%crsreqresponse); + if ($cdom =~ /^$match_domain$/) { + $homeserver = &domain($cdom,'primary'); + } + unless (($homeserver eq 'no_host') || ($homeserver eq '')) { + my $info; + if (ref($inbound) eq 'HASH') { + $info = &freeze_escape($inbound); + } + my $response=&reply('autocrsrequpdate:'.$cdom.':'.$cnum.':'.&escape($crstype). + ':'.&escape($action).':'.&escape($ownername).':'. + &escape($ownerdomain).':'.&escape($fullname).':'. + &escape($title).':'.&escape($code).':'.$info,$homeserver); + unless ($response =~ /(con_lost|error|no_such_host|refused)/) { + my @items = split(/&/,$response); + foreach my $item (@items) { + my ($key,$value) = split('=',$item); + $crsreqresponse{&unescape($key)} = &thaw_unescape($value); + } + } + } + return \%crsreqresponse; +} + # ------------------------------------------------------- Course Group routines sub get_coursegroups { @@ -12136,7 +12163,7 @@ sub fetch_dns_checksums { } sub all_loncaparevs { - return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10); + return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10 2.11); } # ---------------------------------------------------------- Read loncaparev table