--- loncom/lonnet/perl/lonnet.pm 2013/07/09 00:17:27 1.1230 +++ loncom/lonnet/perl/lonnet.pm 2013/07/25 19:11:12 1.1231 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1230 2013/07/09 00:17:27 raeburn Exp $ +# $Id: lonnet.pm,v 1.1231 2013/07/25 19:11:12 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1578,6 +1578,36 @@ sub idput { } } +# ---------------------------------------- Delete unwanted IDs from ids.db file + +sub iddel { + my ($udom,$idshashref,$uhome)=@_; + my %result=(); + unless (ref($idshashref) eq 'HASH') { + return %result; + } + my %servers=(); + while (my ($id,$uname) = each(%{$idshashref})) { + my $uhom; + if ($uhome) { + $uhom = $uhome; + } else { + $uhom=&homeserver($uname,$udom); + } + if ($uhom ne 'no_host') { + if ($servers{$uhom}) { + $servers{$uhom}.='&'.&escape($id); + } else { + $servers{$uhom}=&escape($id); + } + } + } + foreach my $server (keys(%servers)) { + $result{$server} = &critical('iddel:'.$udom.':'.$servers{$server},$uhome); + } + return %result; +} + # ------------------------------dump from db file owned by domainconfig user sub dump_dom { my ($namespace, $udom, $regexp) = @_;