[LON-CAPA-cvs] cvs: loncom /debugging_tools make_slots.pl /homework lonhomework.pm /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Mon, 21 Mar 2005 18:53:52 -0000
albertel Mon Mar 21 13:53:52 2005 EDT
Added files:
/loncom/debugging_tools make_slots.pl
Modified files:
/loncom/lonnet/perl lonnet.pm
/loncom/homework lonhomework.pm
Log:
- implement dslot getting and checking
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.613 loncom/lonnet/perl/lonnet.pm:1.614
--- loncom/lonnet/perl/lonnet.pm:1.613 Fri Mar 18 14:28:20 2005
+++ loncom/lonnet/perl/lonnet.pm Mon Mar 21 13:53:51 2005
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.613 2005/03/18 19:28:20 albertel Exp $
+# $Id: lonnet.pm,v 1.614 2005/03/21 18:53:51 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3717,8 +3717,8 @@
push @check, $file_name;
my %locked = &get('file_permissions',\@check,
$ENV{'user.domain'},$ENV{'user.name'});
- my ($tmp)=keys(%locked);
- if ($tmp=~/^error:/) { undef(%locked); }
+# my ($tmp)=keys(%locked);
+# if ($tmp=~/^error:/) { undef(%locked); }
if (ref($locked{$file_name}) eq 'ARRAY') {
$is_locked = 'true';
@@ -3732,8 +3732,8 @@
sub mark_as_readonly {
my ($domain,$user,$files,$what) = @_;
my %current_permissions = &dump('file_permissions',$domain,$user);
- my ($tmp)=keys(%current_permissions);
- if ($tmp=~/^error:/) { undef(%current_permissions); }
+# my ($tmp)=keys(%current_permissions);
+# if ($tmp=~/^error:/) { undef(%current_permissions); }
foreach my $file (@{$files}) {
push(@{$current_permissions{$file}},$what);
@@ -3816,8 +3816,8 @@
sub get_marked_as_readonly {
my ($domain,$user,$what) = @_;
my %current_permissions = &dump('file_permissions',$domain,$user);
- my ($tmp)=keys(%current_permissions);
- if ($tmp=~/^error:/) { undef(%current_permissions); }
+# my ($tmp)=keys(%current_permissions);
+# if ($tmp=~/^error:/) { undef(%current_permissions); }
my @readonly_files;
while (my ($file_name,$value) = each(%current_permissions)) {
@@ -3838,8 +3838,8 @@
sub get_marked_as_readonly_hash {
my ($domain,$user,$what) = @_;
my %current_permissions = &dump('file_permissions',$domain,$user);
- my ($tmp)=keys(%current_permissions);
- if ($tmp=~/^error:/) { undef(%current_permissions); }
+# my ($tmp)=keys(%current_permissions);
+# if ($tmp=~/^error:/) { undef(%current_permissions); }
my %readonly_files;
while (my ($file_name,$value) = each(%current_permissions)) {
@@ -3862,8 +3862,8 @@
# for portfolio submissions, $what contains $crsid and $symb
my ($domain,$user,$what) = @_;
my %current_permissions = &dump('file_permissions',$domain,$user);
- my ($tmp)=keys(%current_permissions);
- if ($tmp=~/^error:/) { undef(%current_permissions); }
+# my ($tmp)=keys(%current_permissions);
+# if ($tmp=~/^error:/) { undef(%current_permissions); }
my @readonly_files = &get_marked_as_readonly($domain,$user,$what);
foreach my $file(@readonly_files){
@@ -4702,6 +4702,19 @@
return $title;
}
+sub get_slot {
+ my ($which,$cnum,$cdom)=@_;
+ if (!$cnum || !$cdom) {
+ (undef,my $courseid)=&Apache::lonxml::whichuser();
+ $cdom=$ENV{'course.'.$courseid.'.domain'};
+ $cnum=$ENV{'course.'.$courseid.'.num'};
+ }
+ my %slotinfo=&get('slots',[$which],$cdom,$cnum);
+ &Apache::lonhomework::showhash(%slotinfo);
+ my ($tmp)=keys(%slotinfo);
+ if ($tmp=~/^error:/) { return (); }
+ return %{$slotinfo{$which}};
+}
# ------------------------------------------------- Update symbolic store links
sub symblist {
Index: loncom/homework/lonhomework.pm
diff -u loncom/homework/lonhomework.pm:1.200 loncom/homework/lonhomework.pm:1.201
--- loncom/homework/lonhomework.pm:1.200 Thu Mar 17 16:56:04 2005
+++ loncom/homework/lonhomework.pm Mon Mar 21 13:53:51 2005
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Homework handler
#
-# $Id: lonhomework.pm,v 1.200 2005/03/17 21:56:04 albertel Exp $
+# $Id: lonhomework.pm,v 1.201 2005/03/21 18:53:51 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -232,10 +232,12 @@
# }
my $slotstatus='NOT_IN_A_SLOT';
foreach my $slot (@slots) {
+ &Apache::lonxml::debug("getting $slot");
my %slot=&Apache::lonnet::get_slot($slot);
+ &Apache::lonhomework::showhash(%slot);
if ($slot{'starttime'} < time &&
$slot{'endtime'} > time &&
- &check_ip_access($slot{'ip'})) {
+ &check_ip_acc($slot{'ip'})) {
$slotstatus='IN_A_SLOT';
last;
}
Index: loncom/debugging_tools/make_slots.pl
+++ loncom/debugging_tools/make_slots.pl
use Date::Manip;
use GDBM_File;
use Storable qw(nfreeze thaw);
my $fname="/home/httpd/lonUsers/annarbor/9/7/7/9778182de3942c1annarborl2/slots.db";
my %db;
if (! tie(%db,'GDBM_File',$fname,&GDBM_WRITER(),0640)) {
warn "Unable to tie to $fname";
exit;
}
$db{'slot1'}=
&freeze_escape({
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
'endtime' => &UnixDate("Aug 30th 01:00:00 2004","%s"),
'ip' => "*albertelli.com",
});
$db{'slot2'}=
&freeze_escape({
'starttime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'ip' => "*albertelli.com",
});
$db{'slot3'}=
&freeze_escape({
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'ip' => "1.2.3.4",
});
$db{'slot4'}=
&freeze_escape({
'starttime' => &UnixDate("Aug 30th 00:00:00 2004","%s"),
'endtime' => &UnixDate("Aug 30th 00:00:00 2006","%s"),
'ip' => "*albertelli.com",
});
sub freeze_escape {
my ($value)=@_;
if (ref($value)) {
$value=&nfreeze($value);
return '__FROZEN__'.&escape($value);
}
return &escape($value);
}
sub escape {
my $str=shift;
$str =~ s/(\W)/"%".unpack('H2',$1)/eg;
return $str;
}
sub thaw_unescape {
my ($value)=@_;
if ($value =~ /^__FROZEN__/) {
substr($value,0,10,undef);
$value=&unescape($value);
return &thaw($value);
}
return &unescape($value);
}
sub unescape {
my $str=shift;
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
return $str;
}