--- loncom/interface/loncommon.pm 2004/07/12 17:02:07 1.198 +++ loncom/interface/loncommon.pm 2005/02/12 03:27:57 1.248 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.198 2004/07/12 17:02:07 raeburn Exp $ +# $Id: loncommon.pm,v 1.248 2005/02/12 03:27:57 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -59,7 +59,6 @@ use Apache::lonnet(); use GDBM_File; use POSIX qw(strftime mktime); use Apache::Constants qw(:common :http :methods); -use Apache::lonmsg(); use Apache::lonmenu(); use Apache::lonlocal; use HTML::Entities; @@ -250,8 +249,11 @@ of the element the selection from the se =cut sub browser_and_searcher_javascript { + my ($mode)=@_; + if (!defined($mode)) { $mode='edit'; } my $resurl=&lastresurl(); return < END } @@ -368,7 +379,7 @@ sub coursebrowser_javascript { return (< var stdeditbrowser; - function opencrsbrowser(formname,uname,udom,desc) { + function opencrsbrowser(formname,uname,udom,desc,extra_element) { var url = '/adm/pickcourse?'; var filter; if (filter != null) { @@ -385,6 +396,12 @@ sub coursebrowser_javascript { url += 'form=' + formname + '&cnumelement='+uname+ '&cdomelement='+udom+ '&cnameelement='+desc; + if (extra_element !=null && extra_element != '' && formname == 'rolechoice') { + url += '&roleelement='+extra_element; + if (domainfilter == null || domainfilter == '') { + url += '&domainfilter='+extra_element; + } + } var title = 'Course_Browser'; var options = 'scrollbars=1,resizable=1,menubar=0'; options += ',width=700,height=600'; @@ -396,9 +413,9 @@ ENDSTDBRW } sub selectcourse_link { - my ($form,$unameele,$udomele,$desc)=@_; + my ($form,$unameele,$udomele,$desc,$extra_element)=@_; return "".&mt('Select Course').""; + '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course').""; } =pod @@ -481,7 +498,7 @@ sub linked_select_forms { my $first = "document.$formname.$firstselectname"; # output the javascript to do the changing my $result = ''; - $result.=" - (Help Menu) + (Help Menu) ENDTEMPLATE + if ($component_help) { + if (!$text) { + $template=&help_open_topic($component_help,undef,$stayOnPage, + $width,$height).' '.$template; + } else { + my $help_text; + $help_text=&Apache::lonnet::unescape($topic); + $template='
'. + &help_open_topic($component_help,$help_text,$stayOnPage, + $width,$height).''.$template. + '
'; + } + } if ($text ne '') { $template.='' }; return $template; } @@ -728,8 +773,9 @@ sub help_open_bug { # Add the graphic my $title = &mt('Report a Bug'); + my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif"); $template .= <<"ENDTEMPLATE"; - (Bug: $topic) + (Bug: $topic) ENDTEMPLATE if ($text ne '') { $template.='' }; return $template; @@ -772,8 +818,9 @@ sub help_open_faq { # Add the graphic my $title = &mt('View the FAQ'); + my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif"); $template .= <<"ENDTEMPLATE"; - (FAQ: $topic) + (FAQ: $topic) ENDTEMPLATE if ($text ne '') { $template.='' }; return $template; @@ -797,7 +844,7 @@ format. sub csv_translate { my $text = shift; $text =~ s/\"/\"\"/g; - $text =~ s/\n//g; + $text =~ s/\n/ /g; return $text; } @@ -847,8 +894,9 @@ sub define_excel_formats { $format->{'h1'} = $workbook->add_format(bold=>1, size=>18); $format->{'h2'} = $workbook->add_format(bold=>1, size=>16); $format->{'h3'} = $workbook->add_format(bold=>1, size=>14); + $format->{'i'} = $workbook->add_format(italic=>1); $format->{'date'} = $workbook->add_format(num_format=> - 'mmm d yyyy hh:mm AM/PM'); + 'mm/dd/yyyy hh:mm:ss'); return $format; } @@ -1193,9 +1241,11 @@ Outputs: ############################################################### ############################################################### sub decode_user_agent { + my ($r)=@_; my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"}); my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"}); my $httpbrowser=$ENV{"HTTP_USER_AGENT"}; + if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); } my $clientbrowser='unknown'; my $clientversion='0'; my $clientmathml=''; @@ -1710,21 +1760,26 @@ sub get_related_words { =over 4 -=item * plainname($uname,$udom) +=item * plainname($uname,$udom,$first) Takes a users logon name and returns it as a string in -"first middle last generation" form +"first middle last generation" form +if $first is set to 'lastname' then it returns it as +'lastname generation, firstname middlename' if their is a lastname =cut ############################################################### sub plainname { - my ($uname,$udom)=@_; + my ($uname,$udom,$first)=@_; my %names=&Apache::lonnet::get('environment', ['firstname','middlename','lastname','generation'], $udom,$uname); - my $name=$names{'firstname'}.' '.$names{'middlename'}.' '. - $names{'lastname'}.' '.$names{'generation'}; + my $name=&Apache::lonnet::format_name($names{'firstname'}, + $names{'middlename'}, + $names{'lastname'}, + $names{'generation'},$first); + $name=~s/^\s+//; $name=~s/\s+$//; $name=~s/\s+/ /g; if ($name !~ /\S/) { $name=$uname.'@'.$udom; } @@ -1750,8 +1805,19 @@ if the user does not sub nickname { my ($uname,$udom)=@_; - my %names=&Apache::lonnet::get('environment', - ['nickname','firstname','middlename','lastname','generation'],$udom,$uname); + my %names; + if ($uname eq $ENV{'user.name'} && + $udom eq $ENV{'user.domain'}) { + %names=('nickname' => $ENV{'environment.nickname'} , + 'firstname' => $ENV{'environment.firstname'} , + 'middlename' => $ENV{'environment.middlename'}, + 'lastname' => $ENV{'environment.lastname'} , + 'generation' => $ENV{'environment.generation'}); + } else { + %names=&Apache::lonnet::get('environment', + ['nickname','firstname','middlename', + 'lastname','generation'],$udom,$uname); + } my $name=$names{'nickname'}; if ($name) { $name='"'.$name.'"'; @@ -1777,17 +1843,21 @@ Gets a users screenname and returns it a sub screenname { my ($uname,$udom)=@_; - my %names= - &Apache::lonnet::get('environment',['screenname'],$udom,$uname); + if ($uname eq $ENV{'user.name'} && + $udom eq $ENV{'user.domain'}) {return $ENV{'environment.screenname'};} + my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname); return $names{'screenname'}; } + # ------------------------------------------------------------- Message Wrapper sub messagewrapper { - my ($link,$un,$do)=@_; + my ($link,$username,$domain)=@_; return -"$link"; + ''.$link.''; } # --------------------------------------------------------------- Notes Wrapper @@ -1800,8 +1870,8 @@ sub noteswrapper { sub aboutmewrapper { my ($link,$username,$domain,$target)=@_; - return "$link"; + return ''.$link.''; } # ------------------------------------------------------------ Syllabus Wrapper @@ -1812,9 +1882,28 @@ sub syllabuswrapper { if ($fontcolor) { $linktext=''.$linktext.''; } - return "$linktext"; + return qq{$linktext}; +} + +sub track_student_link { + my ($linktext,$sname,$sdom,$target) = @_; + my $link ="/adm/trackstudent"; + my $title = 'View recent activity'; + if (defined($sname) && $sname !~ /^\s*$/ && + defined($sdom) && $sdom !~ /^\s*$/) { + $link .= "?selected_student=$sname:$sdom"; + $title .= ' of this student'; + } + if (defined($target) && $target !~ /^\s*$/) { + $target = qq{target="$target"}; + } else { + $target = ''; + } + return qq{$linktext}; } + + =pod =back @@ -2209,7 +2298,7 @@ sub get_student_view { if (defined($moreenv)) { %form=(%form,%{$moreenv}); } - if ($target eq 'tex') {$form{'grade_target'} = 'tex';} + if (defined($target)) { $form{'grade_target'} = $target; } $feedurl=&Apache::lonnet::clutter($feedurl); my $userview=&Apache::lonnet::ssi_body($feedurl,%form); $userview=~s/\]*\>//gi; @@ -2249,7 +2338,7 @@ sub get_student_answers { =item * &submlink() -Inputs: $text $uname $udom $symb +Inputs: $text $uname $udom $symb $target Returns: A link to grades.pm such as to see the SUBM view of a student @@ -2257,15 +2346,64 @@ Returns: A link to grades.pm such as to ############################################### sub submlink { - my ($text,$uname,$udom,$symb)=@_; + my ($text,$uname,$udom,$symb,$target)=@_; if (!($uname && $udom)) { (my $cursymb, my $courseid,$udom,$uname)= &Apache::lonxml::whichuser($symb); if (!$symb) { $symb=$cursymb; } } if (!$symb) { $symb=&symbread(); } - return ''.$text.''; + $symb=&Apache::lonnet::escape($symb); + if ($target) { $target="target=\"$target\""; } + return ''.$text.''; +} +############################################## + +=pod + +=item * &pgrdlink() + +Inputs: $text $uname $udom $symb $target + +Returns: A link to grades.pm such as to see the PGRD view of a student + +=cut + +############################################### +sub pgrdlink { + my $link=&submlink(@_); + $link=~s/(&command=submission)/$1&showgrading=yes/; + return $link; +} +############################################## + +=pod + +=item * &pprmlink() + +Inputs: $text $uname $udom $symb $target + +Returns: A link to parmset.pm such as to see the PPRM view of a +student andn resource + +=cut + +############################################### +sub pprmlink { + my ($text,$uname,$udom,$symb,$target)=@_; + if (!($uname && $udom)) { + (my $cursymb, my $courseid,$udom,$uname)= + &Apache::lonxml::whichuser($symb); + if (!$symb) { $symb=$cursymb; } + } + if (!$symb) { $symb=&symbread(); } + $symb=&Apache::lonnet::escape($symb); + if ($target) { $target="target=\"$target\""; } + return ''.$text.''; } ############################################## @@ -2295,7 +2433,7 @@ sub maketime { my %th=@_; return POSIX::mktime( ($th{'seconds'},$th{'minutes'},$th{'hours'}, - $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'})); + $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1)); } ######################################### @@ -2366,10 +2504,8 @@ sub domainlogo { my $domain = &determinedomain(shift); # See if there is a logo if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') { - my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; - if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } - return ''.$domain.''; + my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif"); + return ''.$domain.''; } elsif(exists($Apache::lonnet::domaindescription{$domain})) { return $Apache::lonnet::domaindescription{$domain}; } else { @@ -2455,7 +2591,7 @@ other decorations will be returned. =cut sub bodytag { - my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_; + my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle)=@_; $title=&mt($title); $function = &get_users_function() if (!$function); my $img=&designparm($function.'.img',$domain); @@ -2488,7 +2624,7 @@ sub bodytag { if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } # construct main body tag my $bodytag = < + @@ -2501,20 +2637,89 @@ END return $bodytag; } elsif ($ENV{'browser.interface'} eq 'textual') { # Accessibility + return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', $forcereg). '

LON-CAPA: '.$title.'

'; } elsif ($ENV{'environment.remote'} eq 'off') { # No Remote - return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', - $forcereg). - '
'.$title. -'
'; + my $roleinfo=(< + + $ENV{'environment.firstname'} + $ENV{'environment.middlename'} + $ENV{'environment.lastname'} + $ENV{'environment.generation'} +   +
+$role  +
+$realm  + +ENDROLE + my $titleinfo = ''.$title.''; + if ($customtitle) { + $titleinfo = $customtitle; + } + + if ($ENV{'request.state'} eq 'construct') { + my ($uname,$thisdisfn)= + ($ENV{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|); + my $formaction='/priv/'.$uname.'/'.$thisdisfn; + $formaction=~s/\/+/\//g; + unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm + my $parentpath = ''; + my $lastitem = ''; + if ($thisdisfn =~ m-(.+/)([^/]*)$-) { + $parentpath = $1; + $lastitem = $2; + } else { + $lastitem = $thisdisfn; + } + $titleinfo = &Apache::loncommon::help_open_menu('','','','',3,'Authoring'). + 'Construction Space: '. + '
' + .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."$lastitem
" + .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') + .'
' + .&Apache::lonmenu::constspaceform(); + + } + $forcereg=1; + } + my $titletable = ''. + ''.$roleinfo.'
'. + $titleinfo.'
'; + if ($ENV{'request.state'} eq 'construct') { + $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable); + } else { + $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg). + $titletable; + } + return $bodytag; } # # Top frame rendering, Remote is up # + my $titleinfo = ' '.$title.''; + if ($customtitle) { + $titleinfo = $customtitle; + } + # + # Extra info if you are the DC + my $dc_info = ''; + if ($ENV{'user.adv'} && exists($ENV{'user.role.dc./'. + $ENV{'course.'.$ENV{'request.course.id'}. + '.domain'}.'/'})) { + my $cid = $ENV{'request.course.id'}; + $dc_info.= $cid.' '.$ENV{'course.'.$cid.'.internal.coursecode'}; + $dc_info = '('.$dc_info.')'; + } + # return(< @@ -2524,7 +2729,7 @@ $upperleft - $title +$titleinfo $dc_info $ENV{'environment.firstname'} @@ -2539,7 +2744,7 @@ $upperleft $realm  -
+
ENDBODY } @@ -2572,6 +2777,61 @@ sub get_users_function { ############################################### +=pod + +=item get_sections + +Determines all the sections for a course including +sections with students and sections containing other roles. +Incoming parameters: domain, course number, reference to +section hash (keys to be section/group IDs), reference to +array containing roles for which sections should be gathered +(optional). If the fourth argument is undefined, sections +are gathered for any role. + +Returns number of sections. + +=cut + +############################################### +sub get_sections { + my ($cdom,$cnum,$sectioncount,$possible_roles) = @_; + if (!($cdom && $cnum)) { return 0; } + my $cid = $cdom.'_'.$cnum; + my $numsections = 0; + + if (!defined($possible_roles) || (grep/^st$/,@$possible_roles)) { + my ($classlist) = &Apache::loncoursedata::get_classlist($cid,$cdom,$cnum); + my $sec_index = &Apache::loncoursedata::CL_SECTION(); + my $status_index = &Apache::loncoursedata::CL_STATUS(); + while (my ($student,$data) = each %$classlist) { + my ($section,$status) = ($data->[$sec_index], + $data->[$status_index]); + unless ($section eq '-1' || $section =~ /^\s*$/) { + if (!defined($$sectioncount{$section})) { $numsections++; } + $$sectioncount{$section}++; + } + } + } + my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum); + foreach my $user (sort(keys(%courseroles))) { + if ($user !~ /^(\w{2})/) { next; } + my ($role) = ($user =~ /^(\w{2})/); + if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; } + my $section; + if ($role eq 'cr' && + $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) { + $section=$1; + } + if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; } + if (!defined($section) || $section eq '-1') { next; } + if (!defined($$sectioncount{$section})) { $numsections++; } + $$sectioncount{$section}++; + } + return $numsections; +} + + sub get_posted_cgi { my $r=shift; @@ -2680,12 +2940,12 @@ returns cache-controlling header code =cut sub cacheheader { - unless ($ENV{'request.method'} eq 'GET') { return ''; } - my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); - my $output .=' + unless ($ENV{'request.method'} eq 'GET') { return ''; } + my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); + my $output .=' '; - return $output; + return $output; } =pod @@ -2697,12 +2957,13 @@ specifies header code to not have cache =cut sub no_cache { - my ($r) = @_; - unless ($ENV{'request.method'} eq 'GET') { return ''; } - #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); - $r->no_cache(1); - $r->header_out("Pragma" => "no-cache"); - #$r->header_out("Expires" => $date); + my ($r) = @_; + if ($ENV{'REQUEST_METHOD'} ne 'GET' && + $ENV{'request.method'} ne 'GET') { return ''; } + my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time)); + $r->no_cache(1); + $r->header_out("Expires" => $date); + $r->header_out("Pragma" => "no-cache"); } sub content_type { @@ -2844,7 +3105,12 @@ needs $ENV{'form.upfile'} and $ENV{'form sub upfile_record_sep { if ($ENV{'form.upfiletype'} eq 'xml') { } else { - return split(/\n/,$ENV{'form.upfile'}); + my @records; + foreach my $line (split(/\n/,$ENV{'form.upfile'})) { + if ($line=~/^\s*$/) { next; } + push(@records,$line); + } + return @records; } } @@ -3177,6 +3443,9 @@ they are plotted. If undefined, default =item @Values: An array of array references. Each array reference holds data to be plotted in a stacked bar chart. +=item If the final element of @Values is a hash reference the key/value +pairs will be added to the graph definition. + =back Returns: @@ -3197,13 +3466,28 @@ sub DrawBarGraph { '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66', ]; } + my $extra_settings = {}; + if (ref($Values[-1]) eq 'HASH') { + $extra_settings = pop(@Values); + } # my $identifier = &get_cgi_id(); my $id = 'cgi.'.$identifier; if (! @Values || ref($Values[0]) ne 'ARRAY') { return ''; } + # + my @Labels; + if (defined($labels)) { + @Labels = @$labels; + } else { + for (my $i=0;$i<@{$Values[0]};$i++) { + push (@Labels,$i+1); + } + } + # my $NumBars = scalar(@{$Values[0]}); + if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); } my %ValuesHash; my $NumSets=1; foreach my $array (@Values) { @@ -3213,7 +3497,15 @@ sub DrawBarGraph { } # my ($height,$width,$xskip,$bar_width) = (200,120,1,15); - if ($NumBars < 10) { + if ($NumBars < 3) { + $width = 120+$NumBars*32; + $xskip = 1; + $bar_width = 30; + } elsif ($NumBars < 5) { + $width = 120+$NumBars*20; + $xskip = 1; + $bar_width = 20; + } elsif ($NumBars < 10) { $width = 120+$NumBars*15; $xskip = 1; $bar_width = 15; @@ -3231,15 +3523,6 @@ sub DrawBarGraph { $bar_width = 4; } # - my @Labels; - if (defined($labels)) { - @Labels = @$labels; - } else { - for (my $i=0;$i<@{$Values[0]};$i++) { - push (@Labels,$i+1); - } - } - # $Max = 1 if ($Max < 1); if ( int($Max) < $Max ) { $Max++; @@ -3262,6 +3545,11 @@ sub DrawBarGraph { $ValuesHash{$id.'.bar_width'} = $bar_width; $ValuesHash{$id.'.labels'} = join(',',@Labels); # + # Deal with other parameters + while (my ($key,$value) = each(%$extra_settings)) { + $ValuesHash{$id.'.'.$key} = $value; + } + # &Apache::lonnet::appenv(%ValuesHash); return ''; } @@ -3496,8 +3784,8 @@ Inputs: sub chartlink { my ($linktext, $sname, $sdomain) = @_; my $link = ''.$linktext.''; } @@ -3634,6 +3922,45 @@ sub icon { return $iconname; } +sub lonhttpdurl { + my ($url)=@_; + my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'}; + if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; } + return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url; +} + +sub connection_aborted { + my ($r)=@_; + $r->print(" ");$r->rflush(); + my $c = $r->connection; + return $c->aborted(); +} + +# Escapes strings that may have embedded 's that will be put into +# strings as 'strings'. +sub escape_single { + my ($input) = @_; + $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)> + $input =~ s/\'/\\\'/g; # Esacpe the 's.... + return $input; +} + +# Same as escape_single, but escape's "'s This +# can be used for "strings" +sub escape_double { + my ($input) = @_; + $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)> + $input =~ s/\"/\\\"/g; # Esacpe the "s.... + return $input; +} + +# Escapes the last element of a full URL. +sub escape_url { + my ($url) = @_; + my @urlslices = split(/\//, $url,-1); + my $lastitem = &Apache::lonnet::escape(pop(@urlslices)); + return join('/',@urlslices).'/'.$lastitem; +} =pod =back