--- loncom/lonnet/perl/lonnet.pm 2012/04/24 20:31:59 1.1165 +++ loncom/lonnet/perl/lonnet.pm 2012/05/18 15:31:40 1.1168 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1165 2012/04/24 20:31:59 droeschl Exp $ +# $Id: lonnet.pm,v 1.1168 2012/05/18 15:31:40 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -97,6 +97,7 @@ use File::MMagic; use LONCAPA qw(:DEFAULT :match); use LONCAPA::Configuration; use LONCAPA::lonmetadata; +use LONCAPA::Lond; use File::Copy; @@ -2155,8 +2156,7 @@ sub getsection { # If there is a role which has expired, return it. # $courseid = &courseid_to_courseurl($courseid); - my $extra = &freeze_escape({'skipcheck' => 1}); - my %roleshash = &dump('roles',$udom,$unam,$courseid,undef,$extra); + my %roleshash = &dump('roles',$udom,$unam,$courseid); foreach my $key (keys(%roleshash)) { next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/); my $section=$1; @@ -3620,8 +3620,7 @@ sub get_my_roles { unless (defined($udom)) { $udom=$env{'user.domain'}; } my (%dumphash,%nothide); if ($context eq 'userroles') { - my $extra = &freeze_escape({'skipcheck' => 1}); - %dumphash = &dump('roles',$udom,$uname,'.',undef,$extra); + %dumphash = &dump('roles',$udom,$uname); } else { %dumphash= &dump('nohist_userroles',$udom,$uname); @@ -4649,8 +4648,7 @@ sub rolesinit { my ($domain,$username,$authhost)=@_; my $now=time; my %userroles = ('user.login.time' => $now); - my $extra = &freeze_escape({'skipcheck' => 1}); - my $rolesdump=reply("dump:$domain:$username:roles:.::$extra",$authhost); + my $rolesdump=reply("dump:$domain:$username:roles",$authhost); if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || ($rolesdump =~ /^error:/)) { return \%userroles; @@ -4676,7 +4674,9 @@ sub rolesinit { my ($area,$role)=split(/=/,$entry); $area=~s/\_\w\w$//; my ($trole,$tend,$tstart,$group_privs); - if ($role=~/^cr/) { + if ($role=~/^cr/) { +# Custom role, defined by a user +# e.g., user.role.cr/msu/smith/mynewrole if ($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) { ($trole,my $trest)=($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|); ($tend,$tstart)=split('_',$trest); @@ -4684,11 +4684,14 @@ sub rolesinit { $trole=$role; } } elsif ($role =~ m|^gr/|) { +# Role of member in a group, defined within a course/community +# e.g., user.role.gr/msu/04935610a19ee4a5fmsul1/leopards ($trole,$tend,$tstart) = split(/_/,$role); next if ($tstart eq '-1'); ($trole,$group_privs) = split(/\//,$trole); $group_privs = &unescape($group_privs); } else { +# Just a normal role, defined in roles.tab ($trole,$tend,$tstart)=split(/_/,$role); } my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain, @@ -4700,10 +4703,13 @@ sub rolesinit { my $spec=$trole.'.'.$area; my ($tdummy,$tdomain,$trest)=split(/\//,$area); if ($trole =~ /^cr\//) { +# Custom role, defined by a user &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area); } elsif ($trole eq 'gr') { +# Role of a member in a group, defined within a course/community &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart); } else { +# Normal role, defined in roles.tab &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); } if ($trole ne 'gr') { @@ -5070,16 +5076,17 @@ sub del { # -------------------------------------------------------------- dump interface sub dump { - my ($namespace,$udomain,$uname,$regexp,$range,$extra)=@_; + my ($namespace,$udomain,$uname,$regexp,$range)=@_; if (!$udomain) { $udomain=$env{'user.domain'}; } if (!$uname) { $uname=$env{'user.name'}; } my $uhome=&homeserver($uname,$udomain); + if ($regexp) { $regexp=&escape($regexp); } else { $regexp='.'; } - my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range:$extra",$uhome); + my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); my @pairs=split(/\&/,$rep); my %returnhash=(); if (!($rep =~ /^error/ )) { @@ -7289,8 +7296,7 @@ sub get_users_groups { } else { $grouplist = ''; my $courseurl = &courseid_to_courseurl($courseid); - my $extra = &freeze_escape({'skipcheck' => 1}); - my %roleshash = &dump('roles',$udom,$uname,$courseurl,undef,$extra); + my %roleshash = &dump('roles',$udom,$uname,$courseurl); my $access_end = $env{'course.'.$courseid. '.default_enrollment_end_date'}; my $now = time; @@ -8103,13 +8109,16 @@ sub generate_coursenum { } sub is_course { - my ($cdom,$cnum) = @_; - my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef, - undef,'.'); - if (exists($courses{$cdom.'_'.$cnum})) { - return 1; - } - return 0; + my ($cdom, $cnum) = scalar(@_) == 1 ? + ($_[0] =~ /^($match_domain)_($match_courseid)$/) : @_; + + return unless $cdom and $cnum; + + my %courses = &courseiddump($cdom, '.', 1, '.', '.', $cnum, undef, undef, + '.'); + + return unless exists($courses{$cdom.'_'.$cnum}); + return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum; } sub store_userdata { @@ -11980,6 +11989,19 @@ createcourse($udom,$description,$url,$co generate_coursenum($udom,$crstype) : get a unique (unused) course number in domain $udom for course type $crstype (Course or Community). +=item * + +is_course($courseid), is_course($cdom, $cnum) + +Accepts either a combined $courseid (in the form of domain_courseid) or the +two component version $cdom, $cnum. It checks if the specified course exists. + +Returns: + undef if the course doesn't exist, otherwise + in scalar context the combined courseid. + in list context the two components of the course identifier, domain and + courseid. + =back =head2 Resource Subroutines