[BACK]Return to loncommon.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.432 and 1.448

version 1.432, 2006/07/19 10:52:27 version 1.448, 2006/08/30 19:36:49
Line 64  use HTML::Entities; Line 64  use HTML::Entities;
 use Apache::lonhtmlcommon();  use Apache::lonhtmlcommon();
 use Apache::loncoursedata();  use Apache::loncoursedata();
 use Apache::lontexconvert();  use Apache::lontexconvert();
   use Apache::lonclonecourse();
 use LONCAPA;  use LONCAPA;
   
 my $readit;  my $readit;
Line 285  sub browser_and_searcher_javascript { Line 286  sub browser_and_searcher_javascript {
  }   }
         url += 'element=' + elementname + '';          url += 'element=' + elementname + '';
         var title = 'Browser';          var title = 'Browser';
         var options = 'scrollbars=1,resizable=1,menubar=1,location=1';          var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
         options += ',width=700,height=600';          options += ',width=700,height=600';
         editbrowser = open(url,title,options,'1');          editbrowser = open(url,title,options,'1');
         editbrowser.focus();          editbrowser.focus();
Line 306  sub browser_and_searcher_javascript { Line 307  sub browser_and_searcher_javascript {
  }   }
         url += 'element=' + elementname + '';          url += 'element=' + elementname + '';
         var title = 'Search';          var title = 'Search';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
         options += ',width=700,height=600';          options += ',width=700,height=600';
         editsearcher = open(url,title,options,'1');          editsearcher = open(url,title,options,'1');
         editsearcher.focus();          editsearcher.focus();
Line 672  sub help_open_topic { Line 673  sub help_open_topic {
     {      {
  $template .=    $template .= 
   "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".    "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
   "<td bgcolor='#5555FF'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";    "<td bgcolor='#5555FF'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
     }      }
   
     # Add the graphic      # Add the graphic
     my $title = &mt('Online Help');      my $title = &mt('Online Help');
     my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");      my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>   <a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };      if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
Line 766  sub help_open_menu { Line 767  sub help_open_menu {
 sub top_nav_help {  sub top_nav_help {
     my ($text) = @_;      my ($text) = @_;
   
     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height);      $text = &mt($text);
      
     $text = "" if (not defined $text);      my $stayOnPage = 
     $stayOnPage = 0 if (not defined $stayOnPage);   ($env{'browser.interface'}  eq 'textual' ||
     if ($env{'browser.interface'} eq 'textual' ||   $env{'environment.remote'} eq 'off' );
         $env{'environment.remote'} eq 'off' ) {      my $link=  ($stayOnPage) ? "javascript:helpMenu('display')"
         $stayOnPage=1;                       : "javascript:helpMenu('open')";
     }      my $banner_link = &update_help_link(undef,undef,undef,undef,$stayOnPage);
     $width = 620 if (not defined $width);  
     $height = 600 if (not defined $height);  
     my $link='';  
     my $title = &mt('Get help');      my $title = &mt('Get help');
     if ($stayOnPage) {  
  $link = "javascript:helpMenu('display')";      return <<"END";
     } else {  $banner_link
         $link = "javascript:helpMenu('open')";   <a href="$link" title="$title">$text</a>
     }  END
   }
   
   sub help_menu_js {
       my ($text) = @_;
   
       my $stayOnPage = 
    ($env{'browser.interface'}  eq 'textual' ||
    $env{'environment.remote'} eq 'off' );
   
       my $width = 620;
       my $height = 600;
     my $helptopic=&general_help();      my $helptopic=&general_help();
     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);  
     my $details_link = '/adm/help/'.$helptopic.'.hlp';      my $details_link = '/adm/help/'.$helptopic.'.hlp';
     my $template;  
     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();      my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
     my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");  
     my $start_page =      my $start_page =
         &Apache::loncommon::start_page('Help Menu', undef,          &Apache::loncommon::start_page('Help Menu', undef,
        {'frameset'    => 1,         {'frameset'    => 1,
Line 800  sub top_nav_help { Line 807  sub top_nav_help {
         &Apache::loncommon::end_page({'frameset' => 1,          &Apache::loncommon::end_page({'frameset' => 1,
       'js_ready' => 1,});        'js_ready' => 1,});
   
     $template .= <<"ENDTEMPLATE";      my $template .= <<"ENDTEMPLATE";
  <script type="text/javascript">  <script type="text/javascript">
 // <!-- BEGIN LON-CAPA Internal  // <!-- BEGIN LON-CAPA Internal
 // <![CDATA[  // <![CDATA[
 var banner_link = '';  var banner_link = '';
Line 830  function writeHelp(caller) { Line 837  function writeHelp(caller) {
 }  }
 // ]]>  // ]]>
 // END LON-CAPA Internal -->  // END LON-CAPA Internal -->
  </script>  </script>
 $banner_link  
  <a href="$link" title="$title">$text</a>  
 ENDTEMPLATE  ENDTEMPLATE
     return $template;      return $template;
 }  }
Line 868  sub help_open_bug { Line 873  sub help_open_bug {
     {      {
  $template .=    $template .= 
   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".    "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
   "<td bgcolor='#FF5555'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";    "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
     }      }
   
     # Add the graphic      # Add the graphic
     my $title = &mt('Report a Bug');      my $title = &mt('Report a Bug');
     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");      my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>   <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };      if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
Line 913  sub help_open_faq { Line 918  sub help_open_faq {
     {      {
  $template .=    $template .= 
   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".    "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
   "<td bgcolor='#448844'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";    "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
     }      }
   
     # Add the graphic      # Add the graphic
     my $title = &mt('View the FAQ');      my $title = &mt('View the FAQ');
     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");      my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>   <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };      if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
Line 2048  sub nickname { Line 2053  sub nickname {
   
 sub getnames {  sub getnames {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
       if ($udom eq 'public' && $uname eq 'public') {
    return ('lastname' => &mt('Public'));
       }
     my $id=$uname.':'.$udom;      my $id=$uname.':'.$udom;
     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);      my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
     if ($cached) {      if ($cached) {
Line 2085  sub screenname { Line 2093  sub screenname {
 sub messagewrapper {  sub messagewrapper {
     my ($link,$username,$domain,$subject,$text)=@_;      my ($link,$username,$domain,$subject,$text)=@_;
     return       return 
         '<a href="/adm/email?compose=individual&'.          '<a href="/adm/email?compose=individual&amp;'.
         'recname='.$username.'&recdom='.$domain.          'recname='.$username.'&amp;recdom='.$domain.
  '&subject='.&escape($subject).'&text='.&escape($text).'" '.   '&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
         'title="'.&mt('Send message').'">'.$link.'</a>';          'title="'.&mt('Send message').'">'.$link.'</a>';
 }  }
 # --------------------------------------------------------------- Notes Wrapper  # --------------------------------------------------------------- Notes Wrapper
Line 2101  sub noteswrapper { Line 2109  sub noteswrapper {
   
 sub aboutmewrapper {  sub aboutmewrapper {
     my ($link,$username,$domain,$target)=@_;      my ($link,$username,$domain,$target)=@_;
       if (!defined($username)  && !defined($domain)) {
           return;
       }
     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.      return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
  ($target?' target="$target"':'').' title="'.&mt('View this users personal page').'">'.$link.'</a>';   ($target?' target="$target"':'').' title="'.&mt('View this users personal page').'">'.$link.'</a>';
 }  }
Line 2131  sub track_student_link { Line 2142  sub track_student_link {
         $target = '';          $target = '';
     }      }
     if ($start) { $link.='&amp;start='.$start; }      if ($start) { $link.='&amp;start='.$start; }
     return qq{<a href="$link" title="$title" $target>$linktext</a>};      
       return qq{<a href="$link" title="$title" $target>$linktext</a>}.
    &help_open_topic('View_recent_activity');
 }  }
   
 =pod  =pod
Line 2868  sub bodytag { Line 2881  sub bodytag {
                    'alink'   => &designparm($function.'.alink',$domain),                     'alink'   => &designparm($function.'.alink',$domain),
    'vlink'   => &designparm($function.'.vlink',$domain),     'vlink'   => &designparm($function.'.vlink',$domain),
    'link'    => &designparm($function.'.link',$domain),);     'link'    => &designparm($function.'.link',$domain),);
     @$addentries{keys(%design)} = @design{keys(%design)};      @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
   
  # role and realm   # role and realm
     my ($role,$realm) = split(/\./,$env{'request.role'},2);      my ($role,$realm) = split(/\./,$env{'request.role'},2);
Line 2885  sub bodytag { Line 2898  sub bodytag {
     } else {      } else {
         $role = &Apache::lonnet::plaintext($role);          $role = &Apache::lonnet::plaintext($role);
     }      }
   
     if (!$realm) { $realm='&nbsp;'; }      if (!$realm) { $realm='&nbsp;'; }
 # Set messages  # Set messages
     my $messages=&domainlogo($domain);      my $messages=&domainlogo($domain);
Line 2892  sub bodytag { Line 2906  sub bodytag {
     my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};      my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
     if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }      if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
   
     my $extra_body_attr = &make_attr_string($forcereg,$addentries);      my $extra_body_attr = &make_attr_string($forcereg,\%design);
   
 # construct main body tag  # construct main body tag
     my $bodytag = "<body $extra_body_attr>".      my $bodytag = "<body $extra_body_attr>".
Line 2913  sub bodytag { Line 2927  sub bodytag {
     }      }
   
     my $name = &plainname($env{'user.name'},$env{'user.domain'});      my $name = &plainname($env{'user.name'},$env{'user.domain'});
       if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
    undef($role);
       } else {
    $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'});
       }
           
     my $roleinfo=(<<ENDROLE);      my $roleinfo=(<<ENDROLE);
 <td class="LC_title_bar_who">  <td class="LC_title_bar_who">
Line 3167  sub standard_css { Line 3186  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 } 
Line 3187  form, .inline { display: inline; } Line 3207  form, .inline { display: inline; }
 .LC_success {  .LC_success {
   color: green;    color: green;
 }  }
   .LC_icon {
     border: 0px;
   }
   
 table#LC_top_nav, table#LC_menubuttons {  table#LC_top_nav, table#LC_menubuttons {
   width: 100%;    width: 100%;
Line 3274  table#LC_top_nav td.LC_top_nav_exit, Line 3297  table#LC_top_nav td.LC_top_nav_exit,
 table#LC_top_nav td.LC_top_nav_help {  table#LC_top_nav td.LC_top_nav_help {
   width: 2.0em;    width: 2.0em;
 }  }
   table#LC_top_nav td.LC_top_nav_login {
     width: 4.0em;
     text-align: center;
   }
 table.LC_breadcrumbs td, table.LC_docs_path td  {  table.LC_breadcrumbs td, table.LC_docs_path td  {
   background: $tabbg;    background: $tabbg;
   color: $font;    color: $font;
Line 3314  td.LC_menubuttons_img { Line 3341  td.LC_menubuttons_img {
   font-weight: bold;    font-weight: bold;
 }  }
   
   table.LC_aboutme_port {
     border: 0px;
     border-collapse: collapse;
     border-spacing: 0px;
   }
 table.LC_data_table, table.LC_mail_list {  table.LC_data_table, table.LC_mail_list {
   border: 1px solid #000000;    border: 1px solid #000000;
   border-collapse: separate;    border-collapse: separate;
Line 3327  table.LC_data_table tr th, table.LC_cale Line 3359  table.LC_data_table tr th, table.LC_cale
   background-color: $data_table_head;    background-color: $data_table_head;
   font-size: smaller;    font-size: smaller;
 }  }
 table.LC_data_table tr td {  table.LC_data_table tr td, 
   table.LC_aboutme_port tr td {
   background-color: $data_table_light;    background-color: $data_table_light;
   padding: 2px;    padding: 2px;
 }  }
 table.LC_data_table tr.LC_even_row td {  table.LC_data_table tr.LC_even_row td,
   table.LC_aboutme_port tr.LC_even_row td {
   background-color: $data_table_dark;    background-color: $data_table_dark;
 }  }
 table.LC_data_table tr.LC_data_table_highlight td {  table.LC_data_table tr.LC_data_table_highlight td {
Line 3684  sub headtag { Line 3718  sub headtag {
     if ($args->{'force_register'}) {      if ($args->{'force_register'}) {
  $result .= &Apache::lonmenu::registerurl(1);   $result .= &Apache::lonmenu::registerurl(1);
     }      }
       if (!$args->{'no_nav_bar'} 
    && !$args->{'only_body'}
    && !$args->{'frameset'}) {
    $result .= &help_menu_js();
       }
   
     if (ref($args->{'redirect'})) {      if (ref($args->{'redirect'})) {
  my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};   my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
Line 3853  sub start_page { Line 3892  sub start_page {
     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));      #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
     my %head_args;      my %head_args;
     foreach my $arg ('redirect','force_register','domain','function',      foreach my $arg ('redirect','force_register','domain','function',
      'bgcolor') {       'bgcolor','frameset','no_nav_bar','only_body') {
  if (defined($args->{$arg})) {   if (defined($args->{$arg})) {
     $head_args{$arg} = $args->{$arg};      $head_args{$arg} = $args->{$arg};
  }   }
Line 4324  sub get_course_users { Line 4363  sub get_course_users {
         }          }
     }      }
     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {      if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
         my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);          my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
         foreach my $person (@coursepersonnel) {          my $now = time;
           foreach my $person (sort(keys(%coursepersonnel))) {
             my $match = 0;              my $match = 0;
             my $secmatch = 0;              my $secmatch = 0;
               my $status;
             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);              my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
             $user =~ s/:$//;              $user =~ s/:$//;
             if (($role) && (grep(/^\Q$role\E$/,@{$roles}))) {              my ($end,$start) = split(/:/,$coursepersonnel{$person});
               if ($end == -1 || $start == -1) {
                   next;
               }
               if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
                 my ($uname,$udom) = split(/:/,$user);                  my ($uname,$udom) = split(/:/,$user);
                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {                  if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
                     if (grep(/^all$/,@{$sections})) {                      if (grep(/^all$/,@{$sections})) {
Line 4352  sub get_course_users { Line 4398  sub get_course_users {
                     $usec = 'none';                      $usec = 'none';
                 }                  }
                 if ($uname ne '' && $udom ne '') {                  if ($uname ne '' && $udom ne '') {
                     my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role,                      if ($end < $now) {
                                                     $usec);                          $status = 'previous';
                       } elsif ($start > $now) {
                           $status = 'future';
                       } else {
                           $status = 'active';
                       }
                     foreach my $type (keys(%{$types})) {                       foreach my $type (keys(%{$types})) { 
                         if ($status eq $type) {                          if ($status eq $type) {
                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {                              if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
Line 4378  sub get_course_users { Line 4429  sub get_course_users {
                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);                  my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                 if ( defined($csettings{'internal.courseowner'}) ) {                  if ( defined($csettings{'internal.courseowner'}) ) {
                     my $owner = $csettings{'internal.courseowner'};                      my $owner = $csettings{'internal.courseowner'};
                     @{$$users{'ow'}{$owner.':'.$cdom}} = 'any';                      if ($owner !~ /^[^:]+:[^:]+$/) {
                           $owner = $owner.':'.$cdom;
                       }
                       @{$$users{'ow'}{$owner}} = 'any';
                     if (defined($userdata) &&                       if (defined($userdata) && 
  !exists($$userdata{$owner.':'.$cdom})) {   !exists($$userdata{$owner.':'.$cdom})) {
  &get_user_info($cdom,$owner,\%idx,$userdata);   &get_user_info($cdom,$owner,\%idx,$userdata);
Line 5458  sub restore_course_settings { Line 5512  sub restore_course_settings {
 ############################################################  ############################################################
 ############################################################  ############################################################
   
   sub commit_customrole {
       my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_;
       my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.'@'.$three.' in '.$url.
                            ($start?', '.&mt('starting').' '.localtime($start):'').
                            ($end?', ending '.localtime($end):'').': <b>'.
                 &Apache::lonnet::assigncustomrole(
                    $udom,$uname,$url,$three,$four,$five,$end,$start).
                    '</b><br />';
       return $output;
   }
   
   sub commit_standardrole {
       my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec) = @_;
       my $output;
       my $logmsg;
       if ($three eq 'st') {
           my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec);
           if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course')) {
               $output = "Error: $result\n"; 
           } else {
               $output = &mt('Assigning').' '.$three.' in '.$url.
                  ($start?', '.&mt('starting').' '.localtime($start):'').
                  ($end?', '.&mt('ending').' '.localtime($end):'').
                  ': <b>'.$result.'</b><br />'.
                  &mt('Add to classlist').': <b>ok</b><br />';
           }
       } else {
           $output = &mt('Assigning').' '.$three.' in '.$url.
                  ($start?', '.&mt('starting').' '.localtime($start):'').
                  ($end?', '.&mt('ending').' '.localtime($end):'').': <b>'.
                  &Apache::lonnet::assignrole(
                      $udom,$uname,$url,$three,$end,$start).
                      '</b><br />';
       }
       return $output;
   }
   
   sub commit_studentrole {
       my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec) = @_;
       my $linefeed =  '<br />'."\n";
       my $result;
       if (defined($one) && defined($two)) {
           my $cid=$one.'_'.$two;
           my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
           my $secchange = 0;
           my $expire_role_result;
           my $modify_section_result;
           unless ($oldsec eq '-1') {
               unless ($sec eq $oldsec) {
                   $secchange = 1;
                   my $uurl='/'.$cid;
                   $uurl=~s/\_/\//g;
                   if ($oldsec) {
                       $uurl.='/'.$oldsec;
                   }
                   $expire_role_result = &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',time);
                   $result = $expire_role_result;
               }
           }
           if (($expire_role_result eq 'ok') || ($secchange == 0)) {
               $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid);
               if ($modify_section_result =~ /^ok/) {
                   if ($secchange == 1) {
                       $$logmsg .= "Section for $uname switched from old section: $oldsec to new section: $sec".$linefeed;
                   } elsif ($oldsec eq '-1') {
                       $$logmsg .= "New student role for $uname in section $sec in course $cid".$linefeed;
                   } else {
                       $$logmsg .= "Student $uname assigned to unchanged section $sec in course $cid".$linefeed;
                   }
               } else {
                   $$logmsg .= "Error when attempting section change for $uname from old section $oldsec to new section: $sec in course $cid -error: $modify_section_result".$linefeed;
               }
               $result = $modify_section_result;
           } elsif ($secchange == 1) {
               $$logmsg .= "Error when attempting to expire role for $uname in old section $oldsec in course $cid -error: $expire_role_result".$linefeed;
           }
       } else {
           $$logmsg .= "Incomplete course id defined.  Addition of user $uname from domain $udom to course $one\_$two, section $sec not completed.$linefeed";
           $result = "error: incomplete course id\n";
       }
       return $result;
   }
   
   ############################################################
   ############################################################
   
   sub construct_course {
       my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname) = @_;
       my $outcome;
   
   #
   # Open course
   #
       my $crstype = lc($args->{'crstype'});
       my %cenv=();
       $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                                                $args->{'cdescr'},
                                                $args->{'curl'},
                                                $args->{'course_home'},
                                                $args->{'nonstandard'},
                                                $args->{'crscode'},
                                                $args->{'ccuname'}.':'.
                                                $args->{'ccdomain'},
                                                $args->{'crstype'});
   
       # Note: The testing routines depend on this being output; see 
       # Utils::Course. This needs to at least be output as a comment
       # if anyone ever decides to not show this, and Utils::Course::new
       # will need to be suitably modified.
       $outcome .= &mt('New LON-CAPA [_1] ID: [_2]<br />',$crstype,$$courseid);
   #
   # Check if created correctly
   #
       ($$crsudom,$$crsunum)=($$courseid=~/^\/(\w+)\/(\w+)$/);
       my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
       $outcome .= &mt('Created on').': '.$crsuhome.'<br>';
   #
   # Are we cloning?
   #
       my $cloneid='';
       if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
    $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
           my ($clonecrsudom,$clonecrsunum)=($cloneid=~/^\/(\w+)\/(\w+)$/);
    my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
    if ($clonehome eq 'no_host') {
       $outcome .=
       '<br /><font color="red">'.&mt('Attempting to clone non-existing [_1]',$crstype).' '.$cloneid.'</font>';
    } else {
       $outcome .= 
       '<br /><font color="green">'.&mt('Cloning [_1] from [_2]',$crstype,$clonehome).'</font>';
       my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
   # Copy all files
       &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid);
   # Restore URL
       $cenv{'url'}=$oldcenv{'url'};
   # Restore title
       $cenv{'description'}=$oldcenv{'description'};
   # restore grading mode
       if (defined($oldcenv{'grading'})) {
    $cenv{'grading'}=$oldcenv{'grading'};
       }
   # Mark as cloned
       $cenv{'clonedfrom'}=$cloneid;
       delete($cenv{'default_enrollment_start_date'});
       delete($cenv{'default_enrollment_end_date'});
    }
       }
   #
   # Set environment (will override cloned, if existing)
   #
       my @sections = ();
       my @xlists = ();
       if ($args->{'crstype'}) {
           $cenv{'type'}=$args->{'crstype'};
       }
       if ($args->{'crsid'}) {
           $cenv{'courseid'}=$args->{'crsid'};
       }
       if ($args->{'crscode'}) {
           $cenv{'internal.coursecode'}=$args->{'crscode'};
       }
       if ($args->{'crsquota'} ne '') {
           $cenv{'internal.coursequota'}=$args->{'crsquota'};
       } else {
           $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
       }
       if ($args->{'ccuname'}) {
           $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                                           ':'.$args->{'ccdomain'};
       } else {
           $cenv{'internal.courseowner'} = $args->{'curruser'};
       }
   
       my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
       if ($args->{'crssections'}) {
           $cenv{'internal.sectionnums'} = '';
           if ($args->{'crssections'} =~ m/,/) {
               @sections = split/,/,$args->{'crssections'};
           } else {
               $sections[0] = $args->{'crssections'};
           }
           if (@sections > 0) {
               foreach my $item (@sections) {
                   my ($sec,$gp) = split/:/,$item;
                   my $class = $args->{'crscode'}.$sec;
                   my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   $cenv{'internal.sectionnums'} .= $item.',';
                   unless ($addcheck eq 'ok') {
                       push @badclasses, $class;
                   }
               }
               $cenv{'internal.sectionnums'} =~ s/,$//;
           }
       }
   # do not hide course coordinator from staff listing, 
   # even if privileged
       $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
   # add crosslistings
       if ($args->{'crsxlist'}) {
           $cenv{'internal.crosslistings'}='';
           if ($args->{'crsxlist'} =~ m/,/) {
               @xlists = split/,/,$args->{'crsxlist'};
           } else {
               $xlists[0] = $args->{'crsxlist'};
           }
           if (@xlists > 0) {
               foreach my $item (@xlists) {
                   my ($xl,$gp) = split/:/,$item;
                   my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   $cenv{'internal.crosslistings'} .= $item.',';
                   unless ($addcheck eq 'ok') {
                       push @badclasses, $xl;
                   }
               }
               $cenv{'internal.crosslistings'} =~ s/,$//;
           }
       }
       if ($args->{'autoadds'}) {
           $cenv{'internal.autoadds'}=$args->{'autoadds'};
       }
       if ($args->{'autodrops'}) {
           $cenv{'internal.autodrops'}=$args->{'autodrops'};
       }
   # check for notification of enrollment changes
       my @notified = ();
       if ($args->{'notify_owner'}) {
           if ($args->{'ccuname'} ne '') {
               push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
           }
       }
       if ($args->{'notify_dc'}) {
           if ($uname ne '') { 
               push(@notified,$uname.'@'.$udom);
           }
       }
       if (@notified > 0) {
           my $notifylist;
           if (@notified > 1) {
               $notifylist = join(',',@notified);
           } else {
               $notifylist = $notified[0];
           }
           $cenv{'internal.notifylist'} = $notifylist;
       }
       if (@badclasses > 0) {
           my %lt=&Apache::lonlocal::texthash(
                   'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.  However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',
                   'dnhr' => 'does not have rights to access enrollment in these classes',
                   'adby' => 'as determined by the policies of your institution on access to official classlists'
           );
           $outcome .= '<font color="red">'.$lt{'tclb'}.' ('.$cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.' ('.$lt{'adby'}.').<br /><ul>'."\n";
           foreach (@badclasses) {
               $outcome .= "<li>$_</li>\n";
           }
           $outcome .= "</ul><br /><br /></font>\n";
       }
       if ($args->{'no_end_date'}) {
           $args->{'endaccess'} = 0;
       }
       $cenv{'internal.autostart'}=$args->{'enrollstart'};
       $cenv{'internal.autoend'}=$args->{'enrollend'};
       $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
       $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
       if ($args->{'showphotos'}) {
         $cenv{'internal.showphotos'}=$args->{'showphotos'};
       }
       $cenv{'internal.authtype'} = $args->{'authtype'};
       $cenv{'internal.autharg'} = $args->{'autharg'}; 
       if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
           if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
               $outcome .= '<font color="red" size="+1">'.
                         &mt('As you did not include the default Kerberos domain to be used for authentication in this class, the institutional data used by the automated enrollment process must include the Kerberos domain for each new student').'</font></p>';
           }
       }
       if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
          if ($args->{'setpolicy'}) {
              $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
          }
          if ($args->{'setcontent'}) {
              $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
          }
       }
       if ($args->{'reshome'}) {
    $cenv{'reshome'}=$args->{'reshome'}.'/';
    $cenv{'reshome'}=~s/\/+$/\//;
       }
   #
   # course has keyed access
   #
       if ($args->{'setkeys'}) {
          $cenv{'keyaccess'}='yes';
       }
   # if specified, key authority is not course, but user
   # only active if keyaccess is yes
       if ($args->{'keyauth'}) {
    $args->{'keyauth'}=~s/[^\w\@]//g;
    if ($args->{'keyauth'}) {
       $cenv{'keyauth'}=$args->{'keyauth'};
    }
       }
   
       if ($args->{'disresdis'}) {
           $cenv{'pch.roles.denied'}='st';
       }
       if ($args->{'disablechat'}) {
           $cenv{'plc.roles.denied'}='st';
       }
   
       # Record we've not yet viewed the Course Initialization Helper for this 
       # course
       $cenv{'course.helper.not.run'} = 1;
       #
       # Use new Randomseed
       #
       $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
       $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
       #
       # The encryption code and receipt prefix for this course
       #
       $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
       $cenv{'internal.encpref'}=100+int(9*rand(99));
       #
       # By default, use standard grading
       if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
   
       $outcome .= ('<br />'.&mt('Setting environment').': '.                 
             &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).'<br>');
   #
   # Open all assignments
   #
       if ($args->{'openall'}) {
          my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
          my %storecontent = ($storeunder         => time,
                              $storeunder.'.type' => 'date_start');
          
          $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
                    ('resourcedata',\%storecontent,$$crsudom,$$crsunum).'<br>';
      }
   #
   # Set first page
   #
       unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
       || ($cloneid)) {
    use LONCAPA::map;
    $outcome .= &mt('Setting first resource').': ';
   
    my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
           my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
   
           $outcome .= ($fatal?$errtext:'read ok').' - ';
           my $title; my $url;
           if ($args->{'firstres'} eq 'syl') {
       $title='Syllabus';
               $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
           } else {
               $title='Navigate Contents';
               $url='/adm/navmaps';
           }
   
           $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
    (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
   
    if ($errtext) { $fatal=2; }
           $outcome .= ($fatal?$errtext:'write ok').'<br />';
       }
       return $outcome;
   }
   
   ############################################################
   ############################################################
   
 sub course_type {  sub course_type {
     my ($cid) = @_;      my ($cid) = @_;
     if (!defined($cid)) {      if (!defined($cid)) {
Line 5502  sub lonhttpdurl { Line 5927  sub lonhttpdurl {
     return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;      return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
 }  }
   
   sub absolute_url {
       my ($host_name) = @_;
       my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://');
       if ($host_name eq '') {
    $host_name = $ENV{'SERVER_NAME'};
       }
       return $protocol.$host_name;
   }
   
 sub connection_aborted {  sub connection_aborted {
     my ($r)=@_;      my ($r)=@_;
     $r->print(" ");$r->rflush();      $r->print(" ");$r->rflush();
Removed from v.1.432  
changed lines
  Added in v.1.448

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