# The LearningOnline Network with CAPA
# Extract domain, courseID, and symb from a shortened URL,
# and switch role to a role in designated course.
#
# $Id: lontiny.pm,v 1.23 2024/11/17 04:48:15 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package Apache::lontiny;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonhtmlcommon;
use Apache::lonroles;
use Apache::lonuserstate;
use Apache::lonnavmaps;
use Apache::lonlocal;
use LONCAPA qw(:DEFAULT :match);
sub handler {
my $r = shift;
my %user;
my $handle = &Apache::lonnet::check_for_valid_session($r,undef,\%user);
if ($handle ne '') {
my $lonidsdir=$r->dir_config('lonIDsDir');
&Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
if ($r->uri =~ m{^/tiny/($match_domain)/(\w+)$}) {
my ($cdom,$key) = ($1,$2);
if (&Apache::lonnet::domain($cdom) ne '') {
my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
my $tinyurl;
my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
if (defined($cached)) {
$tinyurl = $result;
} else {
my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
if ($currtiny{$key} ne '') {
$tinyurl = $currtiny{$key};
&Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
}
}
if ($tinyurl) {
my ($cnum,$symb) = split(/\&/,$tinyurl);
if ($cnum =~ /^$match_courseid$/) {
my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
if ($chome ne 'no_host') {
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['ttoken']);
my ($linkprot,$linkprotuser,$linkprotexit,$ltoken,$linkprotpbid,$linkprotpburl);
if ($env{'form.ttoken'}) {
my %link_info = &Apache::lonnet::tmpget($env{'form.ttoken'});
if ($link_info{'origurl'} eq $r->uri) {
if ($link_info{'ltoken'}) {
$ltoken = $link_info{'ltoken'};
my %ltoken_info = &Apache::lonnet::tmpget($link_info{'ltoken'});
$linkprot = $ltoken_info{'linkprot'};
$linkprotuser = $ltoken_info{'linkprotuser'};
$linkprotexit = $ltoken_info{'linkprotexit'};
$linkprotpbid = $ltoken_info{'linkprotpbid'};
$linkprotpburl = $ltoken_info{'linkprotpburl'};
} elsif ($link_info{'linkprot'}) {
$linkprot = $link_info{'linkprot'};
if ($link_info{'linkprotuser'}) {
$linkprotuser = $link_info{'linkprotuser'};
}
if ($link_info{'linkprotexit'}) {
$linkprotexit = $link_info{'linkprotexit'};
}
if ($link_info{'linkprotpbid'}) {
$linkprotpbid = $link_info{'linkprotpbid'};
}
if ($link_info{'linkprotpburl'}) {
$linkprotpburl = $link_info{'linkprotpburl'};
}
}
}
}
if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
# Check for ttoken
my $newlauncher = &launch_check($r->uri,$symb,$cdom,$cnum);
my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
if (&Apache::lonnet::is_on_map($url)) {
my $realuri;
if ((&Apache::lonnet::EXT('resource.0.hiddenresource',$symb) =~ /^yes$/i) &&
(!$env{'request.role.adv'})) {
$env{'user.error.msg'}=$r->uri.':bre:1:1:Access to resource denied';
return HTTP_NOT_ACCEPTABLE;
}
if ((&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) &&
(!$env{'request.role.adv'})) {
$realuri = &Apache::lonenc::encrypted(&Apache::lonnet::clutter($url));
if (($url =~ /\.sequence$/) &&
($env{'course.'.$env{'request.course.id'}.'.type'} ne 'Placement')) {
$realuri .= '?navmap=1';
} else {
$realuri .= '?symb='.&Apache::lonenc::encrypted($symb);
}
} else {
$realuri = &Apache::lonnet::clutter($url);
if (($url =~ /\.sequence$/) &&
($env{'course.'.$env{'request.course.id'}.'.type'} ne 'Placement')) {
$realuri .= '?navmap=1';
} else {
$realuri .= '?symb='.$symb;
}
}
my ($update,$reinitresult);
# Check if course needs to be re-initialized
if ($newlauncher) {
$update = 1;
} else {
my $loncaparev = $r->dir_config('lonVersion');
($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev);
if (($reinitresult eq 'main') || ($reinitresult eq 'both')) {
$update = 1;
} elsif (!-e $env{'request.course.fn'}.'.db') {
$update = 1;
} elsif (!$env{'request.role.adv'}) {
my $navmap = Apache::lonnavmaps::navmap->new();
if (ref($navmap)) {
my $res = $navmap->getBySymb($symb);
if (ref($res)) {
my ($enc_in_bighash,$enc_in_parm);
$enc_in_bighash = $res->encrypted();
if (&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) {
$enc_in_parm = 1;
}
if ($enc_in_bighash ne $enc_in_parm) {
$update = 1;
}
}
}
}
}
if ($update) {
my ($furl,$ferr)=
&Apache::lonuserstate::readmap($cdom.'/'.$cnum);
if ($ferr) {
$env{'user.error.msg'}=$r->uri.':bre:0:0:Course not initialized';
$env{'user.reinit'} = 1;
return HTTP_NOT_ACCEPTABLE;
}
}
if (($reinitresult eq 'both') || ($reinitresult eq 'supp')) {
my $possdel;
if ($reinitresult eq 'supp') {
$possdel = 1;
}
my ($supplemental,$refs_updated) = &Apache::loncommon::get_supplemental($cnum,$cdom,'',$possdel);
unless ($refs_updated) {
&Apache::loncommon::set_supp_httprefs($cnum,$cdom,$supplemental,$possdel);
}
}
my $host = $r->headers_in->get('Host');
if (!$host) {
$r->internal_redirect($realuri);
return OK;
} else {
my $protocol = 'http';
if ($r->get_server_port == 443) {
$protocol = 'https';
}
my $location = $protocol.'://'.$host.$realuri;
$r->headers_out->set(Location => $location);
return REDIRECT;
}
}
} else {
my %crsenv = &Apache::lonnet::coursedescription("$cdom/$cnum");
my @possroles = ('in','ta','ep','st','cr','ad');
if ($crsenv{'type'} eq 'Community') {
unshift(@possroles,'co');
} else {
unshift(@possroles,'cc');
}
my %roleshash =
&Apache::lonnet::get_my_roles($env{'user.uname'},$env{'user.domain'},
'userroles',['previous','active','future'],
\@possroles,[$cdom],1);
my (%possroles,$hassection,%active,%expired,%future);
if (keys(%roleshash)) {
my $now = time;
foreach my $entry (keys(%roleshash)) {
if ($entry =~ /^\Q$cnum:$cdom:\E([^:]+):([^:]*)$/) {
my ($role,$sec) = ($1,$2);
$possroles{$role} = $sec;
if ($sec ne '') {
$hassection = 1;
}
my ($tstart,$tend)=split(/\:/,$roleshash{$entry});
my $status = 'active';
if (($tend) && ($tend<=$now)) {
$status = 'previous';
}
if (($tstart) && ($now<$tstart)) {
$status = 'future';
}
if ($status eq 'active') {
$active{$role} = $sec;
} elsif ($status eq 'previous') {
$expired{$tend} = $role.':'.$sec;
} elsif ($status eq 'future') {
$future{$tstart} = $role.':'.$sec;
}
}
}
}
my @allposs = keys(%active);
if ($env{'request.lti.login'}) {
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
if ($env{'request.lti.target'} eq '') {
if ($env{'form.ltitarget'} eq 'iframe') {
&Apache::lonnet::appenv({'request.lti.target' => 'iframe'});
delete($env{'form.ltitarget'});
}
}
if ($env{'form.selectrole'}) {
foreach my $role (@allposs) {
my $newrole = "$role./$cdom/$cnum";
if ($possroles{$allposs[0]} ne '') {
$newrole .= "/$possroles{$role}";
}
if ($env{"form.$newrole"}) {
my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
'&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
if ($env{'form.ltitarget'} eq 'iframe') {
$destination .= '<itarget=iframe';
}
&do_redirect($r,$destination);
return OK;
}
}
}
}
if (@allposs == 0) {
&show_roles($r,\%crsenv,\%active,'','',\%future,\%expired,$linkprot,$linkprotuser,
$linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken);
} elsif (@allposs == 1) {
my $newrole = "$allposs[0]./$cdom/$cnum";
$newrole = "$allposs[0]./$cdom/$cnum";
if ($possroles{$allposs[0]} ne '') {
$newrole .= "/$possroles{$allposs[0]}";
}
my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
'&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
if ($env{'form.ttoken'}) {
$destination .= '&ttoken='.$env{'form.ttoken'};
}
&do_redirect($r,$destination,$linkprot);
} elsif (@allposs > 1) {
if (grep(/^(cc|co)$/,@allposs)) {
my $newrole;
if (exists($possroles{'cc'})) {
$newrole = 'cc';
} else {
$newrole = 'co';
}
$newrole .= "./$cdom/$cnum";
my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
'&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
if ($env{'form.ttoken'}) {
$destination .= '&ttoken='.$env{'form.ttoken'};
}
&do_redirect($r,$destination,$linkprot);
} else {
my $hascustom;
if (grep(/^cr\//,@allposs)) {
$hascustom = 1;
}
&show_roles($r,\%crsenv,\%active,$hassection,$hascustom);
}
}
return OK;
}
}
}
}
}
}
&generic_error($r);
return OK;
} else {
return FORBIDDEN;
}
}
sub launch_check {
my ($linkuri,$symb,$cdom,$cnum) = @_;
my ($linkprotector,$linkproturi,$linkprotexit,$linkprotpbid,$linkprotpburl,
$linkkey,$newlauncher,$prevlaunch);
if ($env{'form.ttoken'}) {
my %link_info = &Apache::lonnet::tmpget($env{'form.ttoken'});
&Apache::lonnet::tmpdel($env{'form.ttoken'});
delete($env{'form.ttoken'});
if ($link_info{'ltoken'}) {
unless (($link_info{'linkprot'}) || ($link_info{'linkkey'} ne '')) {
my %ltoken_info = &Apache::lonnet::tmpget($link_info{'ltoken'});
if ($ltoken_info{'linkprot'}) {
$link_info{'linkprot'} = $ltoken_info{'linkprot'};
} elsif ($ltoken_info{'linkkey'} ne '') {
$link_info{'linkkey'} = $ltoken_info{'linkkey'};
}
}
&Apache::lonnet::tmpdel($link_info{'ltoken'});
}
if ($link_info{'linkprot'}) {
($linkprotector,$linkproturi) = split(/:/,$link_info{'linkprot'},2);
if ($env{'user.linkprotector'}) {
my @protectors = split(/,/,$env{'user.linkprotector'});
unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
push(@protectors,$linkprotector);
@protectors = sort { $a <=> $b } @protectors;
&Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)});
}
} else {
&Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
}
if ($env{'user.linkproturi'}) {
my @proturis = split(/,/,$env{'user.linkproturi'});
unless(grep(/^\Q$linkproturi\E$/,@proturis)) {
push(@proturis,$linkproturi);
@proturis = sort(@proturis);
&Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)});
}
} else {
&Apache::lonnet::appenv({'user.linkproturi' => $linkproturi});
}
if ($link_info{'linkprotexit'}) {
$linkprotexit = $link_info{'linkprotexit'};
}
if ($link_info{'linkprotpbid'}) {
$linkprotpbid = $link_info{'linkprotpbid'};
}
if ($link_info{'linkprotpburl'}) {
$linkprotpburl = $link_info{'linkprotpburl'};
}
} elsif ($link_info{'linkkey'} ne '') {
$linkkey = $link_info{'linkkey'};
my $keyedlinkuri = $linkuri;
if ($env{'user.deeplinkkey'} ne '') {
my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
unless (grep(/^\Q$linkkey\E$/,@linkkeys)) {
push(@linkkeys,$linkkey);
&Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});
}
} else {
&Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
}
if ($env{'user.keyedlinkuri'}) {
my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
unless (grep(/^\Q$keyedlinkuri\E$/,@keyeduris)) {
push(@keyeduris,$keyedlinkuri);
&Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
}
} else {
&Apache::lonnet::appenv({'user.keyedlinkuri' => $keyedlinkuri});
}
}
if ($link_info{'checklaunch'}) {
$newlauncher = 1;
}
if ($link_info{'prevlaunch'} ne '') {
$prevlaunch = $link_info{'prevlaunch'};
}
}
my $currdeeplinklogin = $env{'request.deeplink.login'};
my $deeplink;
if ($symb =~ /\.(page|sequence)$/) {
my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($symb))[2]);
my $navmap = Apache::lonnavmaps::navmap->new();
if (ref($navmap)) {
$deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
}
} else {
$deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
}
if ($deeplink ne '') {
my $disallow;
my ($state,$others,$listed,$scope,$protect,$display,$target,$exit) = split(/,/,$deeplink);
if (($protect ne 'none') && ($protect ne '')) {
my ($acctype,$item) = split(/:/,$protect);
if ($acctype =~ /lti(c|d)$/) {
my $ltitype = $1;
if ($linkprotector) {
unless ($linkprotector.':'.$linkproturi eq $item.$ltitype.':'.$linkuri) {
$disallow = 1;
}
} else {
$disallow = 1;
}
} elsif ($acctype eq 'key') {
if ($linkkey ne '') {
unless ($linkkey eq $item) {
$disallow = 1;
}
} else {
$disallow = 1;
}
}
}
if ($disallow) {
if ($currdeeplinklogin eq $linkuri) {
&Apache::lonnet::delenv('request.deeplink.login');
if ($env{'request.deeplink.target'} ne '') {
&Apache::lonnet::delenv('request.deeplink.target');
}
if ($env{'request.linkprot'} ne '') {
&Apache::lonnet::delenv('request.linkprot');
}
if ($env{'request.linkprotexit'} ne '') {
&Apache::lonnet::delenv('request.linkprotexit');
}
if ($env{'request.linkprotpbid'} ne '') {
&Apache::lonnet::delenv('request.linkprotpbid');
}
if ($env{'request.linkprotpburl'} ne '') {
&Apache::lonnet::delenv('request.linkprotpburl');
}
}
} else {
unless ($currdeeplinklogin eq $linkuri) {
if (($linkprotector) || ($linkkey ne '')) {
$newlauncher = 1;
}
}
if ($linkprotector) {
&Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
if ($linkprotpburl && $linkprotpbid) {
my ($res,$error) = &store_passback_info($cdom,$cnum,$linkuri,$linkprotector,
$scope,$symb,$linkprotpbid,$linkprotpburl,
$currdeeplinklogin);
}
} elsif ($env{'request.linkprot'}) {
&Apache::lonnet::delenv('request.linkprot');
}
if ($linkkey ne '') {
&Apache::lonnet::appenv({'request.linkkey' => $linkkey});
} elsif ($env{'request.linkkey'} ne '') {
&Apache::lonnet::delenv('request.linkkey');
}
if (($linkprotector) || ($linkkey ne '')) {
if ($linkprotexit ne $env{'request.linkprotexit'}) {
if ($linkprotexit) {
&Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
} elsif ($env{'request.linkprotexit'}) {
&Apache::lonnet::delenv('request.linkprotexit');
}
}
if ($linkprotpbid ne $env{'request.linkprotpbid'}) {
if ($linkprotpbid) {
&Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
} elsif ($env{'request.linkprotpbid'}) {
&Apache::lonnet::delenv('request.linkprotpbid');
}
}
if ($linkprotpburl ne $env{'request.linkprotpburl'}) {
if ($linkprotpburl) {
&Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
} elsif ($env{'request.linkprotpburl'}) {
&Apache::lonnet::delenv('request.linkprotpburl');
}
}
} elsif ($prevlaunch) {
foreach my $requestkey ('linkprotpbid','linkprotpburl','linkprotexit') {
if ($env{"request.$requestkey"}) {
&Apache::lonnet::delenv("request.$requestkey");
}
}
}
&Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
if ($target ne '') {
&Apache::lonnet::appenv({'request.deeplink.target' => $target});
} elsif ($env{'request.deeplink.target'} ne '') {
&Apache::lonnet::delenv('request.deeplink.target');
}
}
} else {
if ($linkprotector) {
&Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
} elsif ($env{'request.linkprot'}) {
&Apache::lonnet::delenv('request.linkprot');
}
if ($linkprotexit) {
&Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
} elsif ($env{'request.linkprotexit'}) {
&Apache::lonnet::delenv('request.linkprotexit');
}
if ($linkprotpbid) {
&Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
} elsif ($env{'request.linkprotpbid'}) {
&Apache::lonnet::delenv('request.linkprotpbid');
}
if ($linkprotpburl) {
&Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
} elsif ($env{'request.linkprotpburl'}) {
&Apache::lonnet::delenv('request.linkprotpburl');
}
if ($linkkey ne '') {
&Apache::lonnet::appenv({'request.linkkey' => $linkkey});
} else {
&Apache::lonnet::delenv('request.linkkey');
}
&Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
if ($env{'request.deeplink.target'} ne '') {
&Apache::lonnet::delenv('request.deeplink.target');
}
}
return $newlauncher;
}
#
# Store linkprotpburl and linkprotpbid in user's nohist_$cid_linkprot_pb.db
# $linkuri\0$linkprotector\0$scope = [$linkprotpbid,$linkprotpburl]
# Separately store $symb in course's nohist_linkprot_passback.db
# which should trigger passback:
# $symb => {$linkuri\0$linkprotector\0$scope => 1};
#
sub store_passback_info {
my ($cdom,$cnum,$linkuri,$linkprotector,$scope,$symb,
$linkprotpbid,$linkprotpburl,$currdeeplinklogin) = @_;
my $key = join("\0",($linkuri,$linkprotector,$scope));
my $namespace = 'nohist_'.$cdom.'_'.$cnum.'_linkprot_pb';
if ($linkuri eq $currdeeplinklogin) {
my %pbinfo = &Apache::lonnet::get($namespace,[$key]);
if (ref($pbinfo{$key}) eq 'ARRAY') {
if (($pbinfo{$key}[0] eq $linkprotpbid) &&
($pbinfo{$key}[1] eq $linkprotpburl)) {
return ('ok');
}
}
}
my $now = time;
my $result = &Apache::lonnet::cput($namespace,{$key => [$linkprotpbid,$linkprotpburl]});
my $error;
if (($result eq 'ok') || ($result eq 'con_delayed')) {
$namespace = 'nohist_linkprot_passback';
my %triggers = &Apache::lonnet::get($namespace,[$symb],$cdom,$cnum);
my $newtrigger;
if ((exists($triggers{$symb})) && (ref($triggers{$symb}) eq 'HASH')) {
unless (exists($triggers{$symb}{$key})) {
$newtrigger = 1;
}
} else {
$newtrigger = 1;
}
if ($newtrigger) {
my ($lockhash,$tries,$gotlock);
$lockhash = {
lock => $env{'user.name'}.
':'.$env{'user.domain'},
};
$tries = 0;
$gotlock = &Apache::lonnet::newput($namespace,$lockhash,$cdom,$cnum);
while (($gotlock ne 'ok') && ($tries<10)) {
$tries ++;
sleep (0.1);
$gotlock = &Apache::lonnet::newput($namespace,$lockhash,$cdom,$cnum);
}
if ($gotlock eq 'ok') {
%triggers = &Apache::lonnet::get($namespace,[$symb],$cdom,$cnum);
$triggers{$symb}{$key} = 1;
$result = &Apache::lonnet::cput($namespace,{$symb => $triggers{$symb}},$cdom,$cnum);
my $dellockoutcome = &Apache::lonnet::del($namespace,['lock'],$cdom,$cnum);
} else {
$error = 'nolock';
}
}
}
return ($result,$error);
}
sub do_redirect {
my ($r,$destination,$linkprot) = @_;
my $windowname = 'loncapaclient';
if ($env{'request.lti.login'}) {
$windowname .= 'lti';
}
my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
my $args = {'bread_crumbs' => [{'href' => '','text' => 'Role initialization'},],};
if ($linkprot) {
$args = {'only_body' => 1,
'redirect' => [0,$destination],};
}
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
if ($linkprot) {
$r->print(&Apache::loncommon::start_page('Valid link','',$args).
&Apache::loncommon::end_page());
} else {
$r->print(&Apache::loncommon::start_page('Valid link',$header,$args).
&Apache::lonhtmlcommon::scripttag('self.name="'.$windowname.'";').
'<h1>'.&mt('Welcome').'</h1>'.
'<p>'.&mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','<i>','</i>').'</p><p>'.
'<a href="'.$destination.'">'.&mt('Continue').'</a></p>'.
&Apache::loncommon::end_page());
}
return;
}
sub show_roles {
my ($r,$crsenv,$possroles,$hassection,$hascustom,$futureroles,$expiredroles,
$linkprot,$linkprotuser,$linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken) = @_;
my ($crsdesc,$crstype,$cdom,$cnum,$header,$title,$preamble,$datatable,$js,$args);
if (ref($crsenv) eq 'HASH') {
$crsdesc = $crsenv->{'description'};
$crstype = $crsenv->{'type'};
$cdom = $crsenv->{'domain'};
$cnum = $crsenv->{'num'};
}
if ($crstype eq '') {
$crstype = 'Course';
}
my $lc_crstype = lc($crstype);
if ($crsdesc ne '') {
$header = &mt("The page you requested belongs to the following $lc_crstype: [_1]",
'<i>'.$crsdesc.'</i>');
}
if (ref($possroles) eq 'HASH') {
if (keys(%{$possroles}) > 0) {
$args = {'bread_crumbs' => [{'href' => '','text' => "Choose role in $lc_crstype"},],};
if ($linkprot) {
$args = {'only_body' => 1};
}
$title = 'Choose a role'; #Do not localize.
if ($crstype eq 'Community') {
$preamble = &mt('You have the following active roles in this community:');
} else {
$preamble = &mt('You have the following active roles in this course:');
}
$datatable = '<form name="" action="/adm/roles">'.
'<input type="hidden" name="newrole" value="" />'."\n".
'<input type="hidden" name="selectrole" value="1" />'."\n".
'<input type="hidden" name="destinationurl" value="'.&HTML::Entities::encode($r->uri,'&<>"').'" />'."\n";
if ($env{'form.ttoken'}) {
$datatable .= '<input type="hidden" name="ttoken" value="'.$env{'form.ttoken'}.'" />'."\n";
}
$datatable .= &Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row().
'<th></th><th>'.&mt('User role').'</th>';
if ($hassection) {
$datatable .= '<th>'.&mt('Section').'</th>';
}
if ($hascustom) {
$datatable .= '<th>'.&mt('Information').'</th>';
}
$datatable .= &Apache::loncommon::end_data_table_header_row();
my @available = sort(keys(%{$possroles}));
foreach my $role ('ad','in','ta','ep','st','cr') {
foreach my $key (@available) {
if ($key =~ m{^$role($|/)}) {
my $trolecode = "$key./$cdom/$cnum";
my $rolename = &Apache::lonnet::plaintext($key,$crstype,$cdom.'_'.$cnum);
my $sec = $possroles->{$key};
if ($sec ne '') {
$trolecode .= '/'.$sec;
}
my $buttonname=$trolecode;
$buttonname=~s/\W//g;
$datatable .= &Apache::loncommon::start_data_table_row().
'<td><input name="'.$buttonname.'" type="button" value="'.
&mt('Select').'" onclick="javascript:enterrole(this.form,'.
"'$trolecode','$buttonname'".');" /></td>';
if ($key =~ /^cr\//) {
my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$key);
$datatable .= '<td><span class="LC_nobreak">'.$rolename.'</span></td>';
if ($hassection) {
$datatable .= '<td>'.$sec.'</td>';
}
$datatable.= '<td><span class="LC_fontsize_small LC_cusr_emph">'.
&mt('Custom role defined by [_1]',$rauthor.':'.$rdomain).
'</td>';
} else {
if ($hassection) {
$datatable .= '<td>'.$rolename.'</td>';
if ($hascustom) {
$datatable .= '<td colspan="2">'.$sec.'</td>';
} else {
$datatable .= '<td>'.$sec.'</td>';
}
} elsif ($hascustom) {
$datatable .= '<td colspan="2">'.$rolename.'</td>';
} else {
$datatable .= '<td>'.$rolename.'</td>';
}
}
$datatable .= &Apache::loncommon::end_data_table_row();
}
}
}
$datatable .= &Apache::loncommon::end_data_table().
'</form>';
my $standby = &mt('Role selected. Please stand by.');
$js = <<"ENDJS";
<script type="text/javascript">
// <![CDATA[
active=true;
function enterrole (thisform,rolecode,buttonname) {
if (active) {
active=false;
document.title='$standby';
window.status='$standby';
thisform.newrole.value=rolecode;
thisform.submit();
} else {
alert('$standby');
}
}
// ]]>
</script>
ENDJS
} else {
if ($linkprot) {
$title = 'No access';
$preamble = '<p>'.&mt('Access unavailable for this LON-CAPA content.').'</p>';
$args->{'only_body'} = 1;
} else {
$title = 'No active role';
$preamble = '<p>'.&mt("You have no active roles in this $lc_crstype so the page is currently unavailable to you.").'</p>';
$args = {'bread_crumbs' => [{'href' => '','text' => 'Role status'},],};
}
$header = &mt('No access for: [_1]','<b>'.&Apache::loncommon::plainname($env{'user.name'},
$env{'user.domain'}).'</b>');
if ((ref($futureroles) eq 'HASH') && (keys(%{$futureroles}) > 0)) {
my @future = sort { $a <=> $b } (keys(%{$futureroles}));
$preamble .= '<p>'.&mt('Access will begin: [_1].',&Apache::lonlocal::locallocaltime($future[0])).
' '.&mt('Please try again then.').'</p>';
} elsif ((ref($expiredroles) eq 'HASH') && (keys(%{$expiredroles}) > 0)) {
my @expired = sort { $b <=> $a } (keys(%{$expiredroles}));
$preamble .= '<p>'.&mt('Access ended: [_1].',&Apache::lonlocal::locallocaltime($expired[0])).'</p>';
} elsif ($linkprot) {
if ($linkprotuser) {
my ($uname,$udom) = split(/:/,$linkprotuser,2);
$preamble .= '<p>'.&mt('As you followed a link from another system, while logged into that other system with the username: [_1], it is recommended that you contact your instructor.','<i>'.$uname.'</i>').'</p>';
} else {
my $relogin;
my %data = (
origurl => $r->uri,
linkprot => $linkprot,
linkprotexit => $linkprotexit,
linkprotpbid => $linkprotpbid,
linkprotpburl => $linkprotpburl,
);
my $token =
&Apache::lonnet::tmpput(\%data,$r->dir_config('lonHostID'),'retry');
unless (($token eq 'con_lost') || ($token eq 'refused') || ($token =~ /^error:/) ||
($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
$relogin = '/adm/relaunch?rtoken='.$token;
}
$preamble .= '<p>'.&mt('You might try logging in with a different username and/or domain.').' '.
&mt('You are currently logged in as: [_1] in domain: [_2]',
'<i>'.$env{'user.name'}.'</i>','<i>'.$env{'user.domain'}.'</i>').'</p>';
if ($relogin) {
$preamble .= '<p>'.&mt('[_1]Log-in again[_2]','<a href="'.$relogin.'" target="_self">','</a>').'</p>';
}
}
}
if ($env{'form.ttoken'}) {
&Apache::lonnet::tmpdel($env{'form.ttoken'});
}
if ($ltoken) {
&Apache::lonnet::tmpdel($ltoken);
}
}
}
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
$r->print(&Apache::loncommon::start_page($title,$js,$args).
'<h3>'.$header.'</h3>'.
'<div>'.$preamble.'</div>'.
$datatable.
&Apache::loncommon::end_page());
return;
}
sub generic_error {
my ($r) = @_;
my $continuelink;
unless ($env{'request.lti.login'}) {
my $linktext;
if ($env{'user.adv'}) {
$linktext = &mt('Continue to your roles page');
} else {
$linktext = &mt('Continue to your courses page');
}
$continuelink='<a href="/adm/roles">'.$linktext.'</a>';
}
my $msg = &mt('The page you requested does not exist.');
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $args = {'bread_crumbs' => [{'href' => '','text' => 'Link status'},],};
$r->print(&Apache::loncommon::start_page('Invalid URL',undef,$args).
'<div class="LC_error">'.$msg.'</div>'.
'<p>'.$continuelink.'</p>'.
&Apache::loncommon::end_page());
return;
}
1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lontiny.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface