loncom/interface/loncommon.pm - diff

Return to loncommon.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.512 and 1.539

version 1.512, 2007/03/03 01:33:20	version 1.539, 2007/06/27 22:43:28
Line 68 use Apache::lontexconvert();	Line 68 use Apache::lontexconvert();
use Apache::lonclonecourse();	use Apache::lonclonecourse();
use LONCAPA qw(:DEFAULT :match);	use LONCAPA qw(:DEFAULT :match);

	# ---------------------------------------------- Designs
	use vars qw(%defaultdesign);

my $readit;	my $readit;


##	##
## Global Variables	## Global Variables
##	##
Line 82 my %scprtag;	Line 86 my %scprtag;
my %fe; my %fd; my %fm;	my %fe; my %fd; my %fm;
my %category_extensions;	my %category_extensions;

# ---------------------------------------------- Designs

my %designhash;

# ---------------------------------------------- Thesaurus variables	# ---------------------------------------------- Thesaurus variables
#	#
# %Keywords:	# %Keywords:
Line 151 BEGIN {	Line 151 BEGIN {
}	}
}	}

# -------------------------------------------------------------- domain designs	# -------------------------------------------------------------- default domain designs

my $filename;
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';	my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
opendir(DIR,$designdir);	my $designfile = $designdir.'/default.tab';
while ($filename=readdir(DIR)) {	if ( open (my $fh,"<$designfile") ) {
if ($filename!~/\.tab$/) { next; }	while (my $line = <$fh>) {
my ($domain)=($filename=~/^($match_domain)\./);	next if ($line =~ /^\#/);
{	chomp($line);
my $designfile = $designdir.'/'.$filename;	my ($key,$val)=(split(/\=/,$line));
if ( open (my $fh,"<$designfile") ) {	if ($val) { $defaultdesign{$key}=$val; }
while (my $line = <$fh>) {	}
next if ($line =~ /^\#/);	close($fh);
chomp($line);
my ($key,$val)=(split(/\=/,$line));
if ($val) { $designhash{$domain.'.'.$key}=$val; }
}
close($fh);
}
}

}	}
closedir(DIR);


# ------------------------------------------------------------- file categories	# ------------------------------------------------------------- file categories
{	{
Line 252 Inputs: formname, elementname	Line 240 Inputs: formname, elementname

formname and elementname specify the name of the html form and the name	formname and elementname specify the name of the html form and the name
of the element the selection from the search results will be placed in.	of the element the selection from the search results will be placed in.
	=back
=cut	=cut

sub browser_and_searcher_javascript {	sub browser_and_searcher_javascript {
Line 390 sub coursebrowser_javascript {	Line 378 sub coursebrowser_javascript {
my ($domainfilter,$sec_element,$formname)=@_;	my ($domainfilter,$sec_element,$formname)=@_;
my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role');	my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role');
my $output = '	my $output = '
<script type="text/javascript" language="Javascript" >	<script type="text/javascript">
var stdeditbrowser;'."\n";	var stdeditbrowser;'."\n";
$output .= <<"ENDSTDBRW";	$output .= <<"ENDSTDBRW";
function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {	function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {
Line 1270 sub create_text_file {	Line 1258 sub create_text_file {
sub domain_select {	sub domain_select {
my ($name,$value,$multiple)=@_;	my ($name,$value,$multiple)=@_;
my %domains=map {	my %domains=map {
$_ => $_.' '.$Apache::lonnet::domaindescription{$_}	$_ => $_.' '. &Apache::lonnet::domain($_,'description')
} &Apache::lonnet::all_domains();	} &Apache::lonnet::all_domains();
if ($multiple) {	if ($multiple) {
$domains{''}=&mt('Any domain');	$domains{''}=&mt('Any domain');
Line 1284 sub domain_select {	Line 1272 sub domain_select {

=pod	=pod

	=head1 Routines for form select boxes

	=over 4

	=cut

=item * multiple_select_form($name,$value,$size,$hash,$order)	=item * multiple_select_form($name,$value,$size,$hash,$order)

Returns a string containing a <select> element int multiple mode	Returns a string containing a <select> element int multiple mode
Line 1435 selected");	Line 1429 selected");
#-------------------------------------------	#-------------------------------------------
sub select_dom_form {	sub select_dom_form {
my ($defdom,$name,$includeempty) = @_;	my ($defdom,$name,$includeempty) = @_;
my @domains = &Apache::lonnet::all_domains();	my @domains = sort(&Apache::lonnet::all_domains());
if ($includeempty) { @domains=('',@domains); }	if ($includeempty) { @domains=('',@domains); }
my $selectdomain = "<select name=\"$name\" size=\"1\">\n";	my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
foreach my $dom (@domains) {	foreach my $dom (@domains) {
Line 1451 sub select_dom_form {	Line 1445 sub select_dom_form {

=pod	=pod

=item * get_library_servers($domain)

Returns a hash which contains keys like '103l3' and values like
'kirk.lite.msu.edu'. All of the keys will be for machines in the
given $domain.

=cut

#-------------------------------------------
sub get_library_servers {
return &Apache::lonnet::get_servers($_[0],'library');
}

#-------------------------------------------

=pod

=item * home_server_option_list($domain)	=item * home_server_option_list($domain)

returns a string which contains an <option> list to be used in a	returns a string which contains an <option> list to be used in a
Line 1478 returns a string which contains an <opti	Line 1455 returns a string which contains an <opti
#-------------------------------------------	#-------------------------------------------
sub home_server_option_list {	sub home_server_option_list {
my $domain = shift;	my $domain = shift;
my %servers = &get_library_servers($domain);	my %servers = &Apache::lonnet::get_servers($domain,'library');
my $result = '';	my $result = '';
foreach my $hostid (sort(keys(%servers))) {	foreach my $hostid (sort(keys(%servers))) {
$result.=	$result.=
Line 1490 sub home_server_option_list {	Line 1467 sub home_server_option_list {

=pod	=pod

=back	=back

=cut	=cut

Line 1880 If target_domain is not found in domain.	Line 1857 If target_domain is not found in domain.
#-------------------------------------------	#-------------------------------------------
sub get_auth_defaults {	sub get_auth_defaults {
my $domain=shift;	my $domain=shift;
return ($Apache::lonnet::domain_auth_def{$domain},$Apache::lonnet::domain_auth_arg_def{$domain});	return (&Apache::lonnet::domain($domain,'auth_def'),
	&Apache::lonnet::domain($domain,'auth_arg_def'));

}	}
###############################################################	###############################################################
## End Get Authentication Defaults for Domain ##	## End Get Authentication Defaults for Domain ##
Line 2075 if $first is set to 'lastname' then it r	Line 2054 if $first is set to 'lastname' then it r
###############################################################	###############################################################
sub plainname {	sub plainname {
my ($uname,$udom,$first)=@_;	my ($uname,$udom,$first)=@_;
	return if (!defined($uname) \|\| !defined($udom));
my %names=&getnames($uname,$udom);	my %names=&getnames($uname,$udom);
my $name=&Apache::lonnet::format_name($names{'firstname'},	my $name=&Apache::lonnet::format_name($names{'firstname'},
$names{'middlename'},	$names{'middlename'},
Line 2106 if the user does not	Line 2086 if the user does not

sub nickname {	sub nickname {
my ($uname,$udom)=@_;	my ($uname,$udom)=@_;
	return if (!defined($uname) \|\| !defined($udom));
my %names=&getnames($uname,$udom);	my %names=&getnames($uname,$udom);
my $name=$names{'nickname'};	my $name=$names{'nickname'};
if ($name) {	if ($name) {
Line 2121 sub nickname {	Line 2102 sub nickname {

sub getnames {	sub getnames {
my ($uname,$udom)=@_;	my ($uname,$udom)=@_;
	return if (!defined($uname) \|\| !defined($udom));
if ($udom eq 'public' && $uname eq 'public') {	if ($udom eq 'public' && $uname eq 'public') {
return ('lastname' => &mt('Public'));	return ('lastname' => &mt('Public'));
}	}
Line 2464 sub preferred_languages {	Line 2446 sub preferred_languages {
if ($browser) {	if ($browser) {
@languages=(@languages,split(/\s(\,\|\;\|\:)\s/,$browser));	@languages=(@languages,split(/\s(\,\|\;\|\:)\s/,$browser));
}	}
if ($Apache::lonnet::domain_lang_def{$env{'user.domain'}}) {	if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) {
@languages=(@languages,	@languages=(@languages,
$Apache::lonnet::domain_lang_def{$env{'user.domain'}});	&Apache::lonnet::domain($env{'user.domain'},
	'lang_def'));
}	}
if ($Apache::lonnet::domain_lang_def{$env{'request.role.domain'}}) {	if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) {
@languages=(@languages,	@languages=(@languages,
$Apache::lonnet::domain_lang_def{$env{'request.role.domain'}});	&Apache::lonnet::domain($env{'request.role.domain'},
	'lang_def'));
}	}
if ($Apache::lonnet::domain_lang_def{	if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
$Apache::lonnet::perlvar{'lonDefDomain'}}) {	'lang_def')) {
@languages=(@languages,	@languages=(@languages,
$Apache::lonnet::domain_lang_def{	&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
$Apache::lonnet::perlvar{'lonDefDomain'}});	'lang_def'));
}	}
# turn "en-ca" into "en-ca,en"	# turn "en-ca" into "en-ca,en"
my @genlanguages;	my @genlanguages;
Line 2933 sub blockcheck {	Line 2917 sub blockcheck {
}	}
my $no_ownblock = 0;	my $no_ownblock = 0;
my $no_userblock = 0;	my $no_userblock = 0;
if ($otheruser) {	if ($otheruser && $activity ne 'com') {
# Check if current user has 'evb' priv for this	# Check if current user has 'evb' priv for this
if (defined($own_courses{$course})) {	if (defined($own_courses{$course})) {
foreach my $sec (keys(%{$own_courses{$course}})) {	foreach my $sec (keys(%{$own_courses{$course}})) {
Line 3186 Returns: Determines which domain should	Line 3170 Returns: Determines which domain should
###############################################	###############################################
sub determinedomain {	sub determinedomain {
my $domain=shift;	my $domain=shift;
if (! $domain) {	if (! $domain) {
# Determine domain if we have not been given one	# Determine domain if we have not been given one
$domain = $Apache::lonnet::perlvar{'lonDefDomain'};	$domain = $Apache::lonnet::perlvar{'lonDefDomain'};
if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }	if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
Line 3197 sub determinedomain {	Line 3181 sub determinedomain {
return $domain;	return $domain;
}	}
###############################################	###############################################

	sub devalidate_domconfig_cache {
	my ($udom)=@_;
	&Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
	}

	# ---------------------- Get domain configuration for a domain
	sub get_domainconf {
	my ($udom) = @_;
	my $cachetime=1800;
	my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
	if (defined($cached)) { return %{$result}; }

	my %domconfig = &Apache::lonnet::get_dom('configuration',
	['login','rolecolors'],$udom);
	my %designhash;
	if (keys(%domconfig) > 0) {
	if (ref($domconfig{'login'}) eq 'HASH') {
	foreach my $key (keys(%{$domconfig{'login'}})) {
	$designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
	}
	}
	if (ref($domconfig{'rolecolors'}) eq 'HASH') {
	foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
	if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
	foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
	$designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
	}
	}
	}
	}
	} else {
	my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
	my $designfile = $designdir.'/'.$udom.'.tab';
	if (-e $designfile) {
	if ( open (my $fh,"<$designfile") ) {
	while (my $line = <$fh>) {
	next if ($line =~ /^\#/);
	chomp($line);
	my ($key,$val)=(split(/\=/,$line));
	if ($val) { $designhash{$udom.'.'.$key}=$val; }
	}
	close($fh);
	}
	}
	if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
	$designhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
	}
	}
	&Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
	$cachetime);
	return %designhash;
	}

=pod	=pod

=item * &domainlogo()	=item * &domainlogo()
Line 3210 If the domain logo does not exist, a des	Line 3248 If the domain logo does not exist, a des

###############################################	###############################################
sub domainlogo {	sub domainlogo {
my $domain = &determinedomain(shift);	my $domain = &determinedomain(shift);
# See if there is a logo	my %designhash = &get_domainconf($domain);
if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {	# See if there is a logo
my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif");	if ($designhash{$domain.'.login.domlogo'} ne '') {
return '<img src="'.$logo.'" alt="'.$domain.'" />';	my $imgsrc = $designhash{$domain.'.login.domlogo'};
} elsif(exists($Apache::lonnet::domaindescription{$domain})) {	if ($imgsrc =~ m{^/(adm\|res)/}) {
return $Apache::lonnet::domaindescription{$domain};	if ($imgsrc =~ m{^/res/}) {
	my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
	&Apache::lonnet::repcopy($local_name);
	}
	$imgsrc = &lonhttpdurl($imgsrc);
	}
	return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
	} elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
	return &Apache::lonnet::domain($domain,'description');
} else {	} else {
return '';	return '';
}	}
Line 3252 sub designparm {	Line 3298 sub designparm {
return $env{'environment.color.'.$which};	return $env{'environment.color.'.$which};
}	}
$domain=&determinedomain($domain);	$domain=&determinedomain($domain);
if (exists($designhash{$domain.'.'.$which})) {	my %domdesign = &get_domainconf($domain);
return $designhash{$domain.'.'.$which};	my $output;
	if ($domdesign{$domain.'.'.$which} ne '') {
	$output = $domdesign{$domain.'.'.$which};
} else {	} else {
return $designhash{'default.'.$which};	$output = $defaultdesign{$which};
	}
	if (($which =~ /^(student\|coordinator\|author\|admin)\.img$/) \|\|
	($which =~ /login\.(img\|logo\|domlogo)/)) {
	if ($output =~ m{^/(adm\|res)/}) {
	if ($output =~ m{^/res/}) {
	my $local_name = &Apache::lonnet::filelocation('',$output);
	&Apache::lonnet::repcopy($local_name);
	}
	$output = &lonhttpdurl($output);
	}
}	}
	return $output;
}	}

###############################################	###############################################
Line 3365 sub bodytag {	Line 3424 sub bodytag {
my $bodytag = "<body $extra_body_attr>".	my $bodytag = "<body $extra_body_attr>".
&Apache::lontexconvert::init_math_support();	&Apache::lontexconvert::init_math_support();

if ($bodyonly	if ($bodyonly) {
\|\| ($env{'request.state'} eq 'construct'
&& $env{'environment.remote'} ne 'off' )) {
return $bodytag;	return $bodytag;
} elsif ($env{'browser.interface'} eq 'textual') {	} elsif ($env{'browser.interface'} eq 'textual') {
# Accessibility	# Accessibility
Line 3475 ENDROLE	Line 3532 ENDROLE
# Top frame rendering, Remote is up	# Top frame rendering, Remote is up
#	#

my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.	my $imgsrc = $img;
$lonhttpdPort.$img.'" alt="'.$function.'" />';	if ($img =~ /^\/adm/) {
	$imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img;
	}
	my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';

# Explicit link to get inline menu	# Explicit link to get inline menu
my $menu= ($no_inline_link?''	my $menu= ($no_inline_link?''
Line 3641 sub standard_css {	Line 3701 sub standard_css {
my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px'	my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px'
: '0px 3px 0px 4px';	: '0px 3px 0px 4px';


return <<END;	return <<END;
h1, h2, h3, th { font-family: $sans }	h1, h2, h3, th { font-family: $sans }
a:focus { color: red; background: yellow }	a:focus { color: red; background: yellow }
table.thinborder,	table.thinborder,
table.LC_optres_prior {
border-collapse: collapse;
}
table.thinborder tr th {	table.thinborder tr th {
border-style: solid;	border-style: solid;
border-width: 1px;	border-width: 1px;
background: $tabbg;	background: $tabbg;
}	}
table.thinborder tr td,	table.thinborder tr td {
table.LC_optres_prior tr td {
border-style: solid;	border-style: solid;
border-width: 1px	border-width: 1px
}	}
Line 3670 form, .inline { display: inline; }	Line 3728 form, .inline { display: inline; }
.LC_diff_removed {	.LC_diff_removed {
color: red;	color: red;
}	}

	.LC_info,
.LC_success,	.LC_success,
.LC_diff_added {	.LC_diff_added {
color: green;	color: green;
Line 3677 form, .inline { display: inline; }	Line 3737 form, .inline { display: inline; }
.LC_icon {	.LC_icon {
border: 0px;	border: 0px;
}	}
	.LC_indexer_icon {
	border: 0px;
	height: 22px;
	}

	.LC_internal_info {
	color: #999;
	}

table.LC_pastsubmission {	table.LC_pastsubmission {
border: 1px solid black;	border: 1px solid black;
Line 3739 table#LC_title_bar td.LC_title_bar_role_	Line 3807 table#LC_title_bar td.LC_title_bar_role_
}	}

table#LC_menubuttons_mainmenu {	table#LC_menubuttons_mainmenu {
background: $pgbg;	width: 100%;
border: 0px;	border: 0px;
border-spacing: 1px;	border-spacing: 1px;
padding: 0px 1px;	padding: 0px 1px;
Line 3794 td.LC_table_cell_checkbox {	Line 3862 td.LC_table_cell_checkbox {
text-align: center;	text-align: center;
}	}

	table#LC_mainmenu td.LC_mainmenu_column {
	vertical-align: top;
	}

.LC_menubuttons_inline_text {	.LC_menubuttons_inline_text {
color: $font;	color: $font;
font-family: $sans;	font-family: $sans;
font-size: smaller;	font-size: smaller;
}	}

	.LC_menubuttons_link {
	text-decoration: none;
	}

	.LC_menubuttons_category {
	color: $font;
	background: $pgbg;
	font-family: $sans;
	font-size: larger;
	font-weight: bold;
	}

td.LC_menubuttons_text {	td.LC_menubuttons_text {
	width: 90%;
color: $font;	color: $font;
font-family: $sans;	font-family: $sans;
}	}

td.LC_menubuttons_img {	td.LC_menubuttons_img {
background: $tabbg;
}	}

.LC_current_location {	.LC_current_location {
font-family: $sans;	font-family: $sans;
background: $tabbg;	background: $tabbg;
Line 3816 td.LC_menubuttons_img {	Line 3902 td.LC_menubuttons_img {
font-weight: bold;	font-weight: bold;
}	}

	.LC_rolesmenu_is {
	font-family: $sans;
	}

	.LC_rolesmenu_selected {
	font-family: $sans;
	}

	.LC_rolesmenu_future {
	font-family: $sans;
	}


	.LC_rolesmenu_will {
	font-family: $sans;
	}

	.LC_rolesmenu_will_not {
	font-family: $sans;
	}

	.LC_rolesmenu_expired {
	font-family: $sans;
	}

	.LC_rolesinfo {
	font-family: $sans;
	}

	.LC_dropadd_labeltext {
	font-family: $sans;
	text-align: right;
	}

	.LC_preferences_labeltext {
	font-family: $sans;
	text-align: right;
	}

table.LC_aboutme_port {	table.LC_aboutme_port {
border: 0px;	border: 0px;
border-collapse: collapse;	border-collapse: collapse;
Line 3841 table.LC_nested {	Line 3966 table.LC_nested {
border-spacing: 0px;	border-spacing: 0px;
width: 100%;	width: 100%;
}	}
table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th {	table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
	table.LC_prior_tries tr th {
font-weight: bold;	font-weight: bold;
background-color: $data_table_head;	background-color: $data_table_head;
font-size: smaller;	font-size: smaller;
Line 4218 span.LC_feedback_link {	Line 4344 span.LC_feedback_link {
font-size: larger;	font-size: larger;
}	}

	table.LC_prior_tries {
	border: 1px solid #000000;
	border-collapse: separate;
	border-spacing: 1px;
	}

	table.LC_prior_tries td {
	padding: 2px;
	}

	.LC_answer_correct {
	background: #AAFFAA;
	color: black;
	}
	.LC_answer_charged_try {
	background: #FFAAAA ! important;
	color: black;
	}
	.LC_answer_not_charged_try,
	.LC_answer_no_grade,
	.LC_answer_late {
	background: #FFFFAA;
	color: black;
	}
	.LC_answer_previous {
	background: #AAAAFF;
	color: black;
	}
	.LC_answer_no_message {
	background: #FFFFFF;
	color: black;
	}
	.LC_answer_unknown {
	background: orange;
	color: black;
	}


	span.LC_prior_numerical,
	span.LC_prior_string,
	span.LC_prior_custom,
	span.LC_prior_reaction,
	span.LC_prior_math {
	font-family: monospace;
	white-space: pre;
	}

	span.LC_prior_string {
	font-family: monospace;
	white-space: pre;
	}

	table.LC_prior_option {
	width: 100%;
	border-collapse: collapse;
	}
	table.LC_prior_rank, table.LC_prior_match {
	border-collapse: collapse;
	}
	table.LC_prior_option tr td,
	table.LC_prior_rank tr td,
	table.LC_prior_match tr td {
	border: 1px solid #000000;
	}

	span.LC_nobreak {
	white-space: nowrap;
	}

END	END
}	}

Line 5047 Incoming parameters:	Line 5242 Incoming parameters:
2. user's domain	2. user's domain

Returns:	Returns:
1. Disk quota (in Mb) assigned to student.	1. Disk quota (in Mb) assigned to student.
	2. (Optional) Type of setting: custom or default
	(individually assigned or default for user's
	institutional status).
	3. (Optional) - User's institutional status (e.g., faculty, staff
	or student - types as defined in localenroll::inst_usertypes
	for user's domain, which determines default quota for user.
	4. (Optional) - Default quota which would apply to the user.

If a value has been stored in the user's environment,	If a value has been stored in the user's environment,
it will return that, otherwise it returns the default	it will return that, otherwise it returns the maximal default
for users in the domain.	defined for the user's instituional status(es) in the domain.

=cut	=cut

Line 5060 for users in the domain.	Line 5262 for users in the domain.

sub get_user_quota {	sub get_user_quota {
my ($uname,$udom) = @_;	my ($uname,$udom) = @_;
my $quota;	my ($quota,$quotatype,$settingstatus,$defquota);
if (!defined($udom)) {	if (!defined($udom)) {
$udom = $env{'user.domain'};	$udom = $env{'user.domain'};
}	}
Line 5070 sub get_user_quota {	Line 5272 sub get_user_quota {
if (($udom eq '' \|\| $uname eq '') \|\|	if (($udom eq '' \|\| $uname eq '') \|\|
($udom eq 'public') && ($uname eq 'public')) {	($udom eq 'public') && ($uname eq 'public')) {
$quota = 0;	$quota = 0;
	$quotatype = 'default';
	$defquota = 0;
} else {	} else {
	my $inststatus;
if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {	if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
$quota = $env{'environment.portfolioquota'};	$quota = $env{'environment.portfolioquota'};
	$inststatus = $env{'environment.inststatus'};
} else {	} else {
my %userenv = &Apache::lonnet::dump('environment',$udom,$uname);	my %userenv =
	&Apache::lonnet::get('environment',['portfolioquota',
	'inststatus'],$udom,$uname);
my ($tmp) = keys(%userenv);	my ($tmp) = keys(%userenv);
if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {	if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {
$quota = $userenv{'portfolioquota'};	$quota = $userenv{'portfolioquota'};
	$inststatus = $userenv{'inststatus'};
} else {	} else {
undef(%userenv);	undef(%userenv);
}	}
}	}
	($defquota,$settingstatus) = &default_quota($udom,$inststatus);
if ($quota eq '') {	if ($quota eq '') {
$quota = &default_quota($udom);	$quota = $defquota;
	$quotatype = 'default';
	} else {
	$quotatype = 'custom';
}	}
}	}
return $quota;	if (wantarray) {
	return ($quota,$quotatype,$settingstatus,$defquota);
	} else {
	return $quota;
	}
}	}

###############################################	###############################################
Line 5095 sub get_user_quota {	Line 5312 sub get_user_quota {

=item * &default_quota()	=item * &default_quota()

Retrieves default quota assigned for storage of user portfolio files	Retrieves default quota assigned for storage of user portfolio files,
	given an (optional) user's institutional status.

Incoming parameters:	Incoming parameters:
1. domain	1. domain
	2. (Optional) institutional status(es). This is a : separated list of
	status types (e.g., faculty, staff, student etc.)
	which apply to the user for whom the default is being retrieved.
	If the institutional status string in undefined, the domain
	default quota will be returned.

Returns:	Returns:
1. Default disk quota (in Mb) for user portfolios in the domain.	1. Default disk quota (in Mb) for user portfolios in the domain.
	2. (Optional) institutional type which determined the value of the
	default quota.

If a value has been stored in the domain's configuration db,	If a value has been stored in the domain's configuration db,
it will return that, otherwise it returns 20 (for backwards	it will return that, otherwise it returns 20 (for backwards
compatibility with domains which have not set up a configuration	compatibility with domains which have not set up a configuration
db file; the original statically defined portfolio quota was 20 Mb).	db file; the original statically defined portfolio quota was 20 Mb).

	If the user's status includes multiple types (e.g., staff and student),
	the largest default quota which applies to the user determines the
	default quota returned.

=cut	=cut

###############################################	###############################################


sub default_quota {	sub default_quota {
my ($udom) = @_;	my ($udom,$inststatus) = @_;
my %defaults = &Apache::lonnet::get_dom('configuration',	my ($defquota,$settingstatus);
['portfolioquota'],$udom);	my %quotahash = &Apache::lonnet::get_dom('configuration',
if ($defaults{'portfolioquota'} ne '') {	['quota'],$udom);
return $defaults{'portfolioquota'};	if (ref($quotahash{'quota'}) eq 'HASH') {
	if ($inststatus ne '') {
	my @statuses = split(/:/,$inststatus);
	foreach my $item (@statuses) {
	if ($quotahash{'quota'}{$item} ne '') {
	if ($defquota eq '') {
	$defquota = $quotahash{'quota'}{$item};
	$settingstatus = $item;
	} elsif ($quotahash{'quota'}{$item} > $defquota) {
	$defquota = $quotahash{'quota'}{$item};
	$settingstatus = $item;
	}
	}
	}
	}
	if ($defquota eq '') {
	$defquota = $quotahash{'quota'}{'default'};
	$settingstatus = 'default';
	}
	} else {
	$settingstatus = 'default';
	$defquota = 20;
	}
	if (wantarray) {
	return ($defquota,$settingstatus);
} else {	} else {
return '20';	return $defquota;
}	}
}	}

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

Removed from v.1.512
changed lines
	Added in v.1.539