File:  [LON-CAPA] / loncom / html / adm / helper / newslot.helper
Revision 1.36: download - view: text, annotated - select for diffs
Fri Jul 7 03:52:41 2023 UTC (16 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, HEAD
- Bug 6754 LON-CAPA as LTI Consumer
  Support for access control using slots for both "gradable" and "non-gradable"
  external tools.

<helper title="Slot Creation" requiredpriv="mgq">
  <state name="START" title="Specify Required Attributes"
         help="Slot_RequiredAttributes">

    <nextstate>OPTIONAL</nextstate>

    <exec>
      if (!exists($helper->{'VARS'}{'name'}) ||
	  $helper->{'VARS'}{'name'} !~ /\S/) {
	  &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
	  if (exists($env{'form.name'}) ||
	      $env{'form.name'} =~ /\S/) {
	      $helper->{'VARS'}{'name'}=$env{'form.name'};
	      $helper->{VARS}{'origname'}=$env{'form.name'};
	      $helper->{DATA}{copy} = 1;
	  }
      }
      $helper->{DATA}{origslot} = sub {
	  my ($which,$default)=@_;
	  if (!exists($helper->{'VARS'}{'name'}) ||
	      $helper->{'VARS'}{'name'} !~ /\S/) {
	      return $default;
	  }
	  my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	  my $cdom  = $env{'course.'.$env{'request.course.id'}.'.domain'};
	  my $name=$helper->{VARS}{'origname'};
	  my %slot=&Apache::lonnet::get('slots', [$name], $cdom, $cnum);
	  if (!ref($slot{$name})) { return $default; }
          if (($which eq 'ipdeny') || ($which eq 'ipallow')) {
              if (!exists($slot{$name}{'ip'})) { return $default; }
          } else {
              if (!exists($slot{$name}{$which})) { return $default; }
          }
          if (($which eq 'ipdeny') || ($which eq 'ipallow')) {
              my @allows;
              my @denies;
              foreach my $item (split(',',$slot{$name}{'ip'})) {
                  $item =~ s/^\s*//;
                  $item =~ s/\s*$//;
                  if ($item =~ /^\!(.+)$/) {
                      push(@denies,$1);
                  } else {
                      push(@allows,$item);
                  }
              }
              if ($which eq 'ipdeny') {
                  return join(',',@denies);
              }
              if ($which eq 'ipallow') {
                  return join(',',@allows);
              }
          } else {
	      return $slot{$name}{$which};
          }
      }
    </exec>
    <message>
        <br />Name: <br />&nbsp;&nbsp;&nbsp;
    </message>
    <string variable="name" size="30">
      <validator>
          if ($val=~/^\s*$/) { return 'Must specify a name'; }
          if ($val=~/\s/) { return 'Must not contain spaces'; }
          if ($val=~/\W/) { return 'Must contain only letters, numbers and _'; }
          return undef;
      </validator>
      <defaultvalue>
        return $helper->{'VARS'}{'name'};
      </defaultvalue>
    </string>
    <condition>
      <clause>$helper->{DATA}{copy}</clause>
      <message>
	<p>Changing the Name will create a new slot with the new name, and not rename the existing slot.</p>
      </message>
    </condition>
    <message>
      <br />Start time:<br />&nbsp;&nbsp;&nbsp;
    </message>
    <date variable="starttime" hoursminutes="1">
      <defaultvalue>
        return &{$helper->{DATA}{origslot}}('starttime');
      </defaultvalue>
    </date>
    <message>
      <br />End time:<br />&nbsp;&nbsp;&nbsp;
    </message>
    <date variable="endtime" hoursminutes="1">
      <defaultvalue>
        return &{$helper->{DATA}{origslot}}('endtime');
      </defaultvalue>
      <validator>
         if ($val < $helper->{'VARS'}{'starttime'}) {
	     return 'End time must be later than the start time.';
         }
	 return undef;
      </validator>
    </date>
    <message>
      <br />Type:
    </message>
    <choices variable="type">
      <choice computer='preassigned'>Instructor assignable.</choice>
      <choice computer='schedulable_student'>Student selectable.</choice>
      <defaultvalue>
        return &{$helper->{DATA}{origslot}}('type','preassigned');
      </defaultvalue>
    </choices>
  </state>


  <state name="OPTIONAL" title="Specify Optional Attributes"
	 help="Slot_OptionalAttributes">
    <message>
        <p>Description:<br />&nbsp;&nbsp;&nbsp;
    </message>
    <string variable="description" size="60">
      <defaultvalue>
        return &{$helper->{DATA}{origslot}}('description');
      </defaultvalue>
    </string>
    <condition>
      <clause>$helper->{'VARS'}{'type'} eq 'schedulable_student'</clause>
      <message>
        </p><p>Time students can start reserving:<br />&nbsp;&nbsp;&nbsp;
      </message>
      <date variable="startreserve" hoursminutes="1" anytime="1">
        <defaultvalue>
          return &{$helper->{DATA}{origslot}}('startreserve','anytime');
        </defaultvalue>
        <validator>
           if (defined($val) && $val > $helper->{'VARS'}{'starttime'}) {
	       return 'Reservation time must come before the slot has started.';
           }
	   return undef;
        </validator>
      </date>
      <message>
        </p><p>Time students can no longer reserve:<br />&nbsp;&nbsp;&nbsp;
      </message>
      <date variable="endreserve" hoursminutes="1" anytime="1">
        <defaultvalue>
          return &{$helper->{DATA}{origslot}}('endreserve','anytime');
        </defaultvalue>
        <validator>
           if (defined($val) && $val > $helper->{'VARS'}{'starttime'}) {
               return 'Reservation end time must come before the slot has started.';
           }
           return undef;
        </validator>
      </date>
      <message>
         </p><p>Maximum number of students allowed in this slot:<br />&nbsp;&nbsp;&nbsp;
      </message>
      <string variable="maxspace" size="4">
        <validator>
            if ($val ne '' && $val=~/\D/) { return 'Must be numeric.'; }
            return undef;
        </validator>
        <defaultvalue>
          return &{$helper->{DATA}{origslot}}('maxspace');
        </defaultvalue>
      </string>
      <message>
         </p><p>Period of time when this slot can only be uniquely chosen:<br />&nbsp;&nbsp;&nbsp;Start:
      </message>
      <date variable="startunique" hoursminutes="1" anytime="1">
        <defaultvalue>
          my $default=&{$helper->{DATA}{origslot}}('uniqueperiod','anytime');
          if ($default eq 'anytime') { return 'anytime' };
          if (ref($default)) { return $default->[0]; }
          return 'anytime';
        </defaultvalue>
      </date>
      <message><br />&nbsp;&nbsp;&nbsp;End: </message>
      <date variable="endunique" hoursminutes="1" anytime="1">
        <defaultvalue>
          my $default=&{$helper->{DATA}{origslot}}('uniqueperiod','anytime');
          if ($default eq 'anytime') { return 'anytime' };
          if (ref($default)) { return $default->[1]; }
          return 'anytime';
        </defaultvalue>
        <validator>
           if (defined($val) && $val < $helper->{'VARS'}{'startunique'}) {
	       return 'End time must be later than the start time.';
           }
	   return undef;
        </validator>
      </date>
      <message>
        </p><p>Message(s) triggered by reservation change by student 
      </message>
    <choices variable="reservationmsg">
      <choice computer='only_student'>Sent to student</choice>
      <choice computer='student_and_user_notes_screen'>Sent to student and added to user notes</choice>
      <choice computer='none'>None sent and no record in user notes</choice>
      <defaultvalue>
        my $default=&{$helper->{DATA}{origslot}}('reservationmsg');
        if ($default eq 'only_student') { return $default; }
        if ($default eq 'student_and_user_notes_screen') { return $default; }
        return 'none';
      </defaultvalue>
    </choices>
    </condition>
    <condition>
      <clause>$helper->{'VARS'}{'type'} eq 'preassigned'</clause>
      <exec>
        delete($helper->{'VARS'}{'startreserve'});
        delete($helper->{'VARS'}{'endreserve'});
        delete($helper->{'VARS'}{'maxspace'});
      </exec>
      <message>
         </p><p>Period of time when this slot can only be uniquely assigned:<br />&nbsp;&nbsp;&nbsp;Start:
      </message>
      <date variable="startunique" hoursminutes="1" anytime="1">
        <defaultvalue>
          my $default=&{$helper->{DATA}{origslot}}('uniqueperiod','anytime');
          if ($default eq 'anytime') { return 'anytime' };
          if (ref($default)) { return $default->[0]; }
          return 'anytime';
        </defaultvalue>
      </date>
      <message><br />&nbsp;&nbsp;&nbsp;End: </message>
      <date variable="endunique" hoursminutes="1" anytime="1">
        <defaultvalue>
          my $default=&{$helper->{DATA}{origslot}}('uniqueperiod','anytime');
          if ($default eq 'anytime') { return 'anytime' };
          if (ref($default)) { return $default->[1]; }
          return 'anytime';
        </defaultvalue>
        <validator>
           if (defined($val) && $val < $helper->{'VARS'}{'startunique'}) {
               return 'End time must be later than the start time.';
           }
           return undef;
        </validator>
      </date>
    </condition>
    <message>
      </p><p>Proctored access:
    </message>
    <choices variable="useproctor">
      <choice computer='no'>No proctor checkin required for access.</choice>
      <choice computer='yes'>Require proctored checkin for access.</choice>
      <defaultvalue>
        my $default=&{$helper->{DATA}{origslot}}('proctor');
        if ($default) { return 'yes'; }
        return 'no';
      </defaultvalue>
    </choices>

    <message>
      </p><p>Secret word proctors use to checkin users:<br />&nbsp;&nbsp;&nbsp;
    </message>
    <string variable="secret" size="12">
      <validator>
          return undef;
      </validator>
      <defaultvalue>
        return &{$helper->{DATA}{origslot}}('secret');
      </defaultvalue>
    </string>
    <message>
      </p><p>Slot is:
    </message>
    <helpicon file="Slot_ChoosingResources" />

    <choices variable="restricttosymb">
      <choice nextstate="PROCTOR" computer='any'>usable for any resource.</choice>
      <choice nextstate="MAPSELECT" computer='map'>restricted to resources in specific folder(s)/composite page(s).</choice>
      <choice nextstate="RESOURCESELECT" computer='resource'>restricted to specific resource(s).</choice>
      <defaultvalue>
        my $default=&{$helper->{DATA}{origslot}}('symb');
        if ($default) {
            my @symbs;
            if ($default =~ /,/) {
                @symbs = split(/\s*,\s*/,$default);
            } else {
                @symbs = ($default);
            }
            if (grep(/\.(page|sequence)$/,@symbs)) {
                return 'map';
            } else {
                return 'resource';
            }
        } else {
            return 'any';
        }
      </defaultvalue>
    </choices>

    <message>
        </p><p>IP restrictions -- allow from all except: <br />&nbsp;&nbsp;&nbsp;
    </message>

    <string variable="ipdeny" size="30">
      <validator>
          return undef;
      </validator>
      <defaultvalue>
        return &{$helper->{DATA}{origslot}}('ipdeny');
      </defaultvalue>
    </string>
    
    <message>
	</p><p>IP restrictions -- deny from all except: <br />&nbsp;&nbsp;&nbsp;      
    </message>

    <string variable="ipallow" size="30">
      <validator>
          return undef;
      </validator>
      <defaultvalue>
        return &{$helper->{DATA}{origslot}}('ipallow');
      </defaultvalue>
    </string>

    <message>
      </p><p>Does each student need to use a unique IP address to access a resource with this slot?</p>
    </message>
    <choices variable="iptied">
      <choice computer='no'>No. The student's IP address is not tied for later access to the same resource. </choice>
      <choice computer='yes'>Yes. The IP address on a student's first access to a resource is tied for later access.</choice>
      <choice computer='answer'>Yes. The IP address on a student's first access to a resource is tied for later access (including post-answer date).</choice>
      <defaultvalue>
        my $default=&{$helper->{DATA}{origslot}}('iptied');
        if ($default eq 'yes') { return 'yes'; }
        if ($default eq 'answer') { return 'answer'; }
        return 'no';
      </defaultvalue>
    </choices>
    <message>  </p>  </message>
  </state>


  <state name="RESOURCESELECT" title="Specify Optional Attributes">

    <nextstate>PROCTOR</nextstate>

    <resource variable="symb" multichoice="1">
      <filterfunc>return $res->is_map() || $res->is_problem() || $res->is_tool()</filterfunc>
      <choicefunc>return $res->is_problem() || || $res->is_tool()</choicefunc>
      <valuefunc>return $res->symb()</valuefunc>
      <defaultvalue>
        my @defaults;
        my $default=&{$helper->{DATA}{origslot}}('symb');
        if ($default) {
            @defaults=(split(/\s*,\s*/,$default));
        }
        return @defaults;
      </defaultvalue>
    </resource>    
  </state>

  <state name="MAPSELECT" title="Specify Optional Attributes">

    <nextstate>PROCTOR</nextstate>

    <resource variable="symb" multichoice="1">
      <filterfunc>return $res->is_map()</filterfunc>
      <valuefunc>return $res->symb()</valuefunc>
      <defaultvalue>
        my @defaults;
        my $default=&{$helper->{DATA}{origslot}}('symb');
        if ($default) {
            @defaults=(split(/\s*,\s*/,$default));
        }
        return @defaults;
      </defaultvalue>
    </resource>
  </state>

  <state name="PROCTOR" title="Specify Proctors"
	 help="Slot_SpecifyProctors">

    <skip>
      <clause>$helper->{'VARS'}{'useproctor'} eq 'no'</clause>
      <nextstate>RESTRICTUSER</nextstate>
    </skip>

    <nextstate>RESTRICTUSER</nextstate>

    <student variable="proctor" multichoice="1" coursepersonnel="1"
             activeonly="1" emptyallowed="0">
      <defaultvalue>
        my @defaults;
        my $default=&{$helper->{DATA}{origslot}}('proctor');
        if ($default) {
	    @defaults=(split(',',$default)); 
	}
        return @defaults;
      </defaultvalue>
    </student>
  </state>


  <state name="RESTRICTUSER" title="Restrict slot availability"
	 help="Slot_RestrictAvailibility">
    <skip>
       <clause>$helper->{'VARS'}{'type'} ne 'schedulable_student'</clause>
       <nextstate>FINISH</nextstate>
    </skip>

    <nextstate>FINISH</nextstate>
    <message>
      <p>Slots are by default available to all users in a course, if you would like this slot to be restricted to a subset of users you can specify restrictions.</p>
    </message>

    <message>
      <h3>Select sections to limit slot availability to: </h3>&nbsp;&nbsp;&nbsp;
    </message>
    <section variable="allowedsections" multichoice="1" allowempty="1">
      <defaultvalue>
	return join('|||',
		    split(',',&{$helper->{DATA}{origslot}}('allowedsections')));
      </defaultvalue>
    </section>
    <message>
      <br /><h3>Select users to limit slot availability to: </h3>&nbsp;&nbsp;&nbsp;
    </message>
    <student variable="allowedusers" multichoice="1" coursepersonnel="1"
             activeonly="1" emptyallowed="1">
      <defaultvalue>
	 return split(',',&{$helper->{DATA}{origslot}}('allowedusers'));
      </defaultvalue>
    </student>
  </state>


  <state name="FINISH" title="Creating/Modifying Slot">
	    <message> Created Slot  </message>	
    <final>
      <finalcode>
        my $result;
	if ($helper->{'STATE'} ne 'FINISH') { return; }
	my %slot;

	foreach my $which ('type','starttime','endtime') {
	    $slot{$which} = $helper->{'VARS'}{$which};
	}

	foreach my $which ('description','maxspace','secret') {
	    if ( $helper->{'VARS'}{$which} =~/\S/ ) {
		$slot{$which} = $helper->{'VARS'}{$which};
	    }
	}

        if ($helper->{'VARS'}{'ipdeny'} =~/\S/ ) {
            foreach my $item (split(',',$helper->{'VARS'}{'ipdeny'})) {
                $item =~ s/^\s*//;
                $item =~ s/\s*$//;
                $slot{'ip'} .= '!'.$item.',';
            }
        }

        if ($helper->{'VARS'}{'ipallow'} =~/\S/ ) {
            foreach my $item (split(',',$helper->{'VARS'}{'ipallow'})) {
                $item =~ s/^\s*//;
                $item =~ s/\s*$//;
                $slot{'ip'} .= $item.',';
            }
        }
 
        if ($slot{'ip'} ne '') {
            $slot{'ip'} =~s /,$//;
        }

        if ($helper->{'VARS'}{'type'} eq 'schedulable_student') {
            if (($helper->{'VARS'}{'reservationmsg'} eq 'only_student') ||
               ($helper->{'VARS'}{'reservationmsg'} eq 'student_and_user_notes_screen')) {
                $slot{'reservationmsg'} = $helper->{'VARS'}{'reservationmsg'}; 
            } else {
                $slot{'reservationmsg'} = 'none';
            }
        }

        if (($helper->{'VARS'}{'restricttosymb'} =~ /^(map|resource)$/) && 
            ($helper->{'VARS'}{'symb'} =~ /\S/)) {
            my @symbs;
            foreach my $symb (split(/\|\|\|/, $helper->{'VARS'}{'symb'})) {
                push(@symbs,$symb);
            }
            # make sure the symbs are unique
            my %symbs = map { ($_,1) } @symbs;
            $slot{'symb'}=join(',',sort(keys(%symbs)));
        }

	if ( $helper->{'VARS'}{'startreserve'} > 0) {
		$slot{'startreserve'} = $helper->{'VARS'}{'startreserve'};
	}

        if ( $helper->{'VARS'}{'endreserve'} > 0) {
            $slot{'endreserve'} = $helper->{'VARS'}{'endreserve'};
        }

	if ( $helper->{'VARS'}{'startunique'} > 0 &&
	     $helper->{'VARS'}{'endunique'} > 0 ) {
	    $slot{'uniqueperiod'} = [$helper->{'VARS'}{'startunique'},
				     $helper->{'VARS'}{'endunique'}];
	}

        if ( $helper->{'VARS'}{'iptied'} =~ /^(yes|answer)$/ ) {
            $slot{'iptied'} = lc($helper->{'VARS'}{'iptied'});
        }

        if ( $helper->{'VARS'}{'useproctor'} eq 'yes'
	     && $helper->{'VARS'}{'proctor'} =~/\S/ ) {
	    my @names;
	    # just need the username/domain throw away the other data 
            # that <student> returns
	    foreach my $user (split(/\|\|\|/, $helper->{'VARS'}{'proctor'})) {
		my ($uname,$udomain)=split(/:/,$user);
		push(@names,"$uname:$udomain");
	    }
	    # make sure the usernames are unique
	    my %proctors = map { ($_,1) } @names;
	    $slot{'proctor'}=join(',',sort(keys(%proctors)));
	}

        if ( $helper->{'VARS'}{'allowedsections'} =~/\S/ ) {
	    $slot{'allowedsections'}=
		join(',',sort(split(/\|\|\|/,
				    $helper->{'VARS'}{'allowedsections'})));
	}

        if ( $helper->{'VARS'}{'allowedusers'} =~/\S/ ) {
	    my @names;
	    # just need the username/domain throw away the other data 
            # that <student> returns
	    foreach my $item (split(/\|\|\|/,
				    $helper->{'VARS'}{'allowedusers'})) {
		my ($uname,$udomain)=split(/:/,$item);
		push(@names,"$uname:$udomain");
	    }

	    # make sure the choices are unique
	    my %users = map { ($_,1) } @names;
	    $slot{'allowedusers'}=join(',',sort(keys(%users)));
	}

        my $cname = $env{'course.'.$env{'request.course.id'}.'.num'};
        my $cdom  = $env{'course.'.$env{'request.course.id'}.'.domain'};

        my $ret = &Apache::lonnet::cput('slots',
					{$helper->{'VARS'}{'name'} => \%slot},
					$cdom,$cname);
        if ($ret eq 'ok') {
            &Apache::lonnet::devalidate_slots_cache($cname,$cdom);
        }
        $result.="\n ".'Name: '.&HTML::Entities::encode($helper->{'VARS'}{'name'}).'</li>'.
    "\n".'<li> Starts: '.&Apache::lonlocal::locallocaltime($slot{'starttime'}).'</li>'.
                 "\n".'<li> Ends: '.&Apache::lonlocal::locallocaltime($slot{'endtime'}).'</li>'.
                 "\n".'<li> Type: '.$slot{'type'}.'</li>';
        my %labels =
             map {($_->[0],$_->[1])} &Apache::slotrequest::csvupload_fields();
        foreach my $which ('ip','description','maxspace','secret',
			   'allowedsections','allowedusers') {
	    if (exists($slot{$which})) {
		$result.="\n".'<li> '.$labels{$which}.': '.
		    &HTML::Entities::encode($slot{$which}).'</li>';
	    }
	}
        if (exists($slot{'iptied'})) {
            $result.="\n".'<li> '.$labels{'iptied'}.': ';
            if ($slot{'iptied'} eq 'yes') {
                $result.=&Apache::lonlocal::mt('yes');
            } elsif ($slot{'iptied'} eq 'answer') {
                $result.=&Apache::lonlocal::mt('yes, including post-answer date');
            }
            $result.='</li>';
        }
        if (exists($slot{'symb'})) {
            $result.="\n".'<li> '.$labels{'symb'}.': ';
            if ($slot{'symb'} =~ /,/) {
                $result.='<ul>';
                foreach my $symb (split(/\s*,\s*/,$slot{'symb'})) {
                    $result.='<li>'.&HTML::Entities::encode($symb).'</li>';
                }
                $result.='</ul>';
            } else {
                $result.=&HTML::Entities::encode($slot{'symb'});
            }
            $result.='</li>';
        }
	if (exists($slot{'startreserve'})) {
	    $result.="\n".'<li> '.$labels{'startreserve'}.': '.
		    &Apache::lonlocal::locallocaltime($slot{'startreserve'}).'</li>';
	}

        if (exists($slot{'endreserve'})) {
            $result.="\n".'<li> '.$labels{'endreserve'}.': '.
                    &Apache::lonlocal::locallocaltime($slot{'endreserve'}).'</li>';
        }

        if (exists($slot{'reservationmsg'})) {
            my %options = &Apache::slotrequest::slot_reservationmsg_options();
            $result.="\n".'<li> '.$labels{'reservationmsg'}.': '.
                          $options{$slot{'reservationmsg'}}.'</li>';
        }

        if (exists($slot{'proctor'})) {
	    my $proctors = $slot{'proctor'};
	    $proctors =~ s/,/, /g;
	    $result.="\n".'<li> '.$labels{'proctor'}.': '.
		&HTML::Entities::encode($proctors).'</li>';
	}
        if (exists($slot{'uniqueperiod'})) {
	    $result.=
                 "\n".'<li> '.$labels{'uniqueperiod'}.': '.
		 &Apache::lonlocal::locallocaltime($slot{'uniqueperiod'}[0]).
		 ', '.
		 &Apache::lonlocal::locallocaltime($slot{'uniqueperiod'}[1]).
		 '</li>';
	}
        return $result;
      </finalcode>
      <exitpage>/adm/slotrequest?command=showslots</exitpage>
    </final>
  </state>
</helper>

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>