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

Diff for /loncom/interface/loncommon.pm between versions 1.435 and 1.459

version 1.435, 2006/07/20 04:17:55 version 1.459, 2006/09/22 19:59:30
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 256  of the element the selection from the se Line 257  of the element the selection from the se
 sub browser_and_searcher_javascript {  sub browser_and_searcher_javascript {
     my ($mode)=@_;      my ($mode)=@_;
     if (!defined($mode)) { $mode='edit'; }      if (!defined($mode)) { $mode='edit'; }
     my $resurl=&lastresurl();      my $resurl=&escape_single(&lastresurl());
     return <<END;      return <<END;
 // <!-- BEGIN LON-CAPA Internal  // <!-- BEGIN LON-CAPA Internal
     var editbrowser = null;      var editbrowser = null;
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 728  sub update_help_link { Line 729  sub update_help_link {
     my $banner_link = "/adm/helpmenu?page=banner&amp;topic=$topic&amp;component_help=$component_help&amp;faq=$faq&amp;bug=$bug&amp;origurl=$origurl&amp;stamp=$timestamp&amp;stayonpage=$stayOnPage";      my $banner_link = "/adm/helpmenu?page=banner&amp;topic=$topic&amp;component_help=$component_help&amp;faq=$faq&amp;bug=$bug&amp;origurl=$origurl&amp;stamp=$timestamp&amp;stayonpage=$stayOnPage";
     my $output .= <<"ENDOUTPUT";      my $output .= <<"ENDOUTPUT";
 <script type="text/javascript">  <script type="text/javascript">
 // <!-- BEGIN LON-CAPA Internal  
 banner_link = '$banner_link';  banner_link = '$banner_link';
 // END LON-CAPA Internal -->  
 </script>  </script>
 ENDOUTPUT  ENDOUTPUT
     return $output;      return $output;
Line 766  sub help_open_menu { Line 765  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 805  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 835  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 871  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 916  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 2088  sub screenname { Line 2091  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 2104  sub noteswrapper { Line 2107  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 user's personal page").'">'.$link.'</a>';
 }  }
   
 # ------------------------------------------------------------ Syllabus Wrapper  # ------------------------------------------------------------ Syllabus Wrapper
Line 2134  sub track_student_link { Line 2140  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 2345  sub preferred_languages { Line 2353  sub preferred_languages {
          $env{'course.'.$env{'request.course.id'}.'.languages'}));           $env{'course.'.$env{'request.course.id'}.'.languages'}));
     }      }
     if ($env{'environment.languages'}) {      if ($env{'environment.languages'}) {
  @languages=split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'});   @languages=(@languages,
       split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'}));
     }      }
     my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];      my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];
     if ($browser) {      if ($browser) {
Line 2871  sub bodytag { Line 2880  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 2896  sub bodytag { Line 2905  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 3176  sub standard_css { Line 3185  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 3190  form, .inline { display: inline; } Line 3200  form, .inline { display: inline; }
   color: red;    color: red;
   font-size: larger;    font-size: larger;
 }  }
 .LC_warning {  .LC_warning,
   .LC_diff_removed {
   color: red;    color: red;
 }  }
 .LC_success {  .LC_success,
   .LC_diff_added {
   color: green;    color: green;
 }  }
   .LC_icon {
     border: 0px;
   }
   
   table.LC_pastsubmission {
     border: 1px solid black;
     margin: 2px;
   }
   
 table#LC_top_nav, table#LC_menubuttons {  table#LC_top_nav, table#LC_menubuttons {
   width: 100%;    width: 100%;
Line 3283  table#LC_top_nav td.LC_top_nav_exit, Line 3303  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 3323  td.LC_menubuttons_img { Line 3347  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 3336  table.LC_data_table tr th, table.LC_cale Line 3365  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 {
   background-color: $data_table_darker;    background-color: $data_table_darker;
 }  }
 table.LC_data_table tr.LC_empty_row td {  table.LC_data_table tr.LC_empty_row td,
   table.LC_whatsnew tr.LC_empty_row td {
   background-color: #FFFFFF;    background-color: #FFFFFF;
   font-weight: bold;    font-weight: bold;
   font-style: italic;    font-style: italic;
Line 3354  table.LC_data_table tr.LC_empty_row td { Line 3386  table.LC_data_table tr.LC_empty_row td {
   padding: 8px;    padding: 8px;
 }  }
   
   table.LC_whatsnew {
   }
   
   table.LC_whatsnew tr th,
   table.LC_whatsnew tr.LC_info_row td {
     background-color: #CCC;
     font-weight: bold;
     font-size: small;
     text-align: right;
   }
   table.LC_whatsnew tr td {
     background-color: #FFF;
     font-size: small;
     text-align: right;
   }
   table.LC_whatsnew tr td.LC_first_item {
     text-align: left;
   }
   
   table.LC_whatsnew tr.LC_odd_row td {
     background-color: #EEE;
   }
   
 table.LC_calendar {  table.LC_calendar {
   border: 1px solid #000000;    border: 1px solid #000000;
   border-collapse: collapse;    border-collapse: collapse;
Line 3452  table#LC_browser tr.LC_browser_file_unpu Line 3507  table#LC_browser tr.LC_browser_file_unpu
 table#LC_browser tr.LC_browser_file_obsolete {  table#LC_browser tr.LC_browser_file_obsolete {
   background: #AAAAAA;    background: #AAAAAA;
 }  }
 table#LC_browser tr.LC_browser_file_modified {  table#LC_browser tr.LC_browser_file_modified,
   table#LC_browser tr.LC_browser_file_metamodified {
   background: #FFFF77;    background: #FFFF77;
 }  }
 table#LC_browser tr.LC_browser_folder {  table#LC_browser tr.LC_browser_folder {
Line 3679  sub headtag { Line 3735  sub headtag {
     my $domain   = $args->{'domain'}   || &determinedomain();      my $domain   = $args->{'domain'}   || &determinedomain();
     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);      my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
     my $url = join(':',$env{'user.name'},$env{'user.domain'},      my $url = join(':',$env{'user.name'},$env{'user.domain'},
      $Apache::lonnet::perlvar{'lonVersion'},
    #time(),     #time(),
    $env{'environment.color.timestamp'},     $env{'environment.color.timestamp'},
    $function,$domain,$bgcolor);     $function,$domain,$bgcolor);
Line 3693  sub headtag { Line 3750  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 3862  sub start_page { Line 3924  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 4333  sub get_course_users { Line 4395  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 4361  sub get_course_users { Line 4430  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 4387  sub get_course_users { Line 4461  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 5465  sub restore_course_settings { Line 5542  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 {
Removed from v.1.435  
changed lines
  Added in v.1.459

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