loncom/interface/lonmenu.pm - diff

Return to lonmenu.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonmenu.pm between versions 1.4 and 1.31

version 1.4, 2001/06/02 16:10:44	version 1.31, 2003/01/29 15:22:06
Line 1	Line 1
# The LearningOnline Network with CAPA	# The LearningOnline Network with CAPA
# Routines to control the menu	# Routines to control the menu
#	#
	# $Id$
	#
	# 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/
	#
# (TeX Conversion Module	# (TeX Conversion Module
#	#
# 05/29/00,05/30 Gerd Kortemeyer)	# 05/29/00,05/30 Gerd Kortemeyer)
#	#
# 10/05,05/28,05/30,06/01 Gerd Kortemeyer	# 10/05,05/28,05/30,06/01,06/08,06/09,07/04,08/07 Gerd Kortemeyer
	# 02/15/02 Matthew Hall

package Apache::lonmenu;	package Apache::lonmenu;

Line 13 use strict;	Line 38 use strict;
use Apache::lonnet;	use Apache::lonnet;
use Apache::File;	use Apache::File;
use vars qw(@desklines $readdesk);	use vars qw(@desklines $readdesk);

	# ================================================================= Reopen menu

	sub reopenmenu {
	my $nothing='';
	my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
	if ($ENV{'browser.type'} eq 'explorer') { $nothing='javascript:void(0);'; }
	return('window.open("'.$nothing.'","'.$menuname.'","",false);');
	}

# =============================================================== Open the menu	# =============================================================== Open the menu

sub open {	sub open {
return(<<ENDOPEN);	my $returnval='';
<script>	my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
window.status='MenuControl:nologout';	unless (shift eq 'unix') {
menu=window.open("/res/adm/pages/menu.html","LONCAPAmenu",	# resizing does not work on linux because of virtual desktop sizes
"height=350,width=150,scrollbars=no,menubar=no");	$returnval.=(<<ENDRESIZE);
</script>	if (window.screen) {
	self.resizeTo(screen.availWidth-215,screen.availHeight-55);
	self.moveTo(190,15);
	}
	ENDRESIZE
	}
	$returnval.=(<<ENDOPEN);
	var menu=window.open("/res/adm/pages/menu.html","$menuname",
	"height=350,width=150,scrollbars=no,menubar=no,top=5,left=5,screenX=5,screenY=5");
ENDOPEN	ENDOPEN
	return '<script>'.$returnval.'</script>';
}	}

# ============================================================ Switch Menu Item	# ============================================================ Switch Menu Item

sub switchmenu {	sub switchmenu {
my ($row,$col,$imgsrc,$texttop,$textbot,$action)=@_;	my ($row,$col,$imgsrc,$texttop,$textbot,$action,$description)=@_;
	my $openwin=&openmenu();
return(<<ENDSMENU);	return(<<ENDSMENU);
<script>	<script>
swmenu=window.open('','LONCAPAmenu');	var swmenu=$openwin
swmenu.switchbutton($row,$col,"$imgsrc","$texttop","$textbot","$action");	swmenu.switchbutton($row,$col,"$imgsrc","$texttop","$textbot","$action","$description");
</script>	</script>
ENDSMENU	ENDSMENU
}	}
Line 45 sub clear {	Line 89 sub clear {
return qq(swmenu.clearbut($row,$col););	return qq(swmenu.clearbut($row,$col););
}	}

	# Switch acts on the javascript that is executed when a button is clicked.
	# The javascript is usually similar to "go('/adm/roles')" or "cstrgo(..)".
sub switch {	sub switch {
my ($uname,$udom,$row,$col,$img,$top,$bot,$act)=@_;	my ($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc)=@_;
$act=~s/\$uname/$uname/g;	$act=~s/\$uname/$uname/g;
$act=~s/\$udom/$udom/g;	$act=~s/\$udom/$udom/g;
return "\n".	return "\n".
qq(swmenu.switchbutton($row,$col,"$img","$top","$bot","$act"););	qq(swmenu.switchbutton($row,$col,"$img","$top","$bot","$act","$desc"););
}	}

sub secondlevel {	sub secondlevel {
my $output='';	my $output='';
my	my
($uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act)=@_;	($uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc)=@_;
if ($prt eq 'any') {	if ($prt eq 'any') {
$output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act);	$output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
} elsif ($prt=~/^r(\w+)/) {	} elsif ($prt=~/^r(\w+)/) {
if ($rol eq $1) {	if ($rol eq $1) {
$output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act);	$output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
}	}
}	}
return $output;	return $output;
}	}

	sub openmenu {
	my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
	if ($ENV{'browser.type'} eq 'explorer') {
	return "window.open('javascript:void(0);','".$menuname."');";
	} else {
	return "window.open('','".$menuname."');";
	}
	}

sub rawconfig {	sub rawconfig {
my $output="swmenu=window.open('','LONCAPAmenu');";	my $r = shift;
	my $output="var swmenu=".&openmenu();
my $uname=$ENV{'user.name'};	my $uname=$ENV{'user.name'};
my $udom=$ENV{'user.domain'};	my $udom=$ENV{'user.domain'};
my $adv=$ENV{'user.adv'};	my $adv=$ENV{'user.adv'};
my $author=$ENV{'user.author'};	my $author=$ENV{'user.author'};
my $crs='/'.$ENV{'request.course.id'};	my $crs='';
$crs=~s/\_/\//;	if ($ENV{'request.course.id'}) {
	$crs='/'.$ENV{'request.course.id'};
	if ($ENV{'request.course.sec'}) {
	$crs.='_'.$ENV{'request.course.sec'};
	}
	$crs=~s/\_/\//g;
	}
my $pub=($ENV{'request.state'} eq 'published');	my $pub=($ENV{'request.state'} eq 'published');
my $con=($ENV{'request.state'} eq 'construct');	my $con=($ENV{'request.state'} eq 'construct');
my $rol=$ENV{'request.role'};	my $rol=$ENV{'request.role'};
map {	my $requested_domain = $ENV{'request.role.domain'};
my ($row,$col,$pro,$prt,$img,$top,$bot,$act)=split(/\:/,$_);	foreach (@desklines) {
	my ($row,$col,$pro,$prt,$img,$top,$bot,$act,$desc)=split(/\:/,$_);
$prt=~s/\$uname/$uname/g;	$prt=~s/\$uname/$uname/g;
$prt=~s/\$udom/$udom/g;	$prt=~s/\$udom/$udom/g;
$prt=~s/\$crs/$crs/g;	$prt=~s/\$crs/$crs/g;
	$prt=~s/\$requested_domain/$requested_domain/g;
if ($pro eq 'clear') {	if ($pro eq 'clear') {
$output.=&clear($row,$col);	$output.=&clear($row,$col);
} elsif ($pro eq 'any') {	} elsif ($pro eq 'any') {
$output.=&secondlevel(	$output.=&secondlevel(
$uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act);	$uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
} elsif ($pro eq 'smp') {	} elsif ($pro eq 'smp') {
unless ($adv) {	unless ($adv) {
$output.=&secondlevel(	$output.=&secondlevel(
$uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act);	$uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
}	}
} elsif ($pro eq 'adv') {	} elsif ($pro eq 'adv') {
if ($adv) {	if ($adv) {
$output.=&secondlevel(	$output.=&secondlevel(
$uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act);	$uname,$udom,$rol,$crs,$pub,$con,$row,$col,$prt,$img,$top,$bot,$act,$desc);
}	}
} elsif (($pro=~/p(\w+)/) && ($prt)) {	} elsif (($pro=~/p(\w+)/) && ($prt)) {
if (&Apache::lonnet::allowed($1,$prt)) {	if (&Apache::lonnet::allowed($1,$prt)) {
$output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act);	$output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
}	}
	} elsif ($pro eq 'course') {
	if ($ENV{'request.course.fn'}) {
	$output.=switch($uname,$udom,$row,$col,$img,$top,$bot,$act,$desc);
	}
} elsif ($pro eq 'author') {	} elsif ($pro eq 'author') {
if ($author) {	if ($author) {
	if ((($prt eq 'rca') && ($ENV{'request.role'}=~/^ca/)) \|\|
	(($prt eq 'rau') && ($ENV{'request.role'}=~/^au/))) {
	# Check that we are on the correct machine
	my $cadom=$requested_domain;
	my $caname=$ENV{'user.name'};
	if ($prt eq 'rca') {
	($cadom,$caname)=
	($ENV{'request.role'}=~/(\w+)\/(\w+)$/);
	}
	$act =~ s/\$caname/$caname/g;
	my $home = &Apache::lonnet::homeserver($caname,$cadom);
	if ($home eq $r->dir_config('lonHostID')) {
	$output.=switch($caname,$cadom,
	$row,$col,$img,$top,$bot,$act,$desc);
	}
	}
}	}
}	}
} @desklines;	}
	$output.="swmenu.syncclock(1000*".time.");";
return $output;	return $output;
}	}

# ======================================================================= Close	# ======================================================================= Close

sub close {	sub close {
	my $menuname='LCmenu'.$Apache::lonnet::perlvar{'lonHostID'};
return(<<ENDCLOSE);	return(<<ENDCLOSE);
<script>	<script>
window.status='MenuControl:nologout';	menu=window.open("/adm/rat/empty.html","$menuname",
menu=window.open("/adm/rat/empty.html","LONCAPAmenu",
"height=350,width=150,scrollbars=no,menubar=no");	"height=350,width=150,scrollbars=no,menubar=no");
	menu.autologout=0;
menu.close();	menu.close();
</script>	</script>
ENDCLOSE	ENDCLOSE
Line 131 sub footer {	Line 217 sub footer {

# ================================================================ Main Program	# ================================================================ Main Program

sub BEGIN {	BEGIN {
if ($readdesk ne 'done') {	if (! defined($readdesk)) {
{	{
my $config=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.	my $config=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
'/mydesk.tab');	'/mydesk.tab');
while (my $configline=<$config>) {	while (my $configline=<$config>) {
	$configline=(split(/\#/,$configline))[0];
	$configline=~s/^\s+//;
chomp($configline);	chomp($configline);
$desklines[$#desklines+1]=$configline;	if ($configline) {
	$desklines[$#desklines+1]=$configline;
	}
}	}
	}
	$readdesk='done';
}	}
}	}
}
1;	1;
__END__	__END__

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

Removed from v.1.4
changed lines
	Added in v.1.31