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

Diff for /loncom/interface/loncommon.pm between versions 1.350 and 1.355

version 1.350, 2006/04/22 17:17:49 version 1.355, 2006/04/25 21:24:06
Line 76  my %language; Line 76  my %language;
 my %supported_language;  my %supported_language;
 my %cprtag;  my %cprtag;
 my %scprtag;  my %scprtag;
 my %fe; my %fd;  my %fe; my %fd; my %fm;
 my %category_extensions;  my %category_extensions;
   
 # ---------------------------------------------- Designs  # ---------------------------------------------- Designs
Line 133  BEGIN { Line 133  BEGIN {
             close($fh);              close($fh);
         }          }
     }      }
 # ------------------------------------------------------------------ source copyrights  # ----------------------------------------------------------- source copyrights
     {      {
         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.          my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                                   '/source_copyright.tab';                                    '/source_copyright.tab';
Line 196  BEGIN { Line 196  BEGIN {
             while (<$fh>) {              while (<$fh>) {
                 next if (/^\#/);                  next if (/^\#/);
                 chomp;                  chomp;
                 my ($ending,$emb,$descr)=split(/\s+/,$_,3);                  my ($ending,$emb,$mime,$descr)=split(/\s+/,$_,4);
                 if ($descr ne '') {                  if ($descr ne '') {
                     $fe{$ending}=lc($emb);                      $fe{$ending}=lc($emb);
                     $fd{$ending}=$descr;                      $fd{$ending}=$descr;
                       if ($mime ne 'unk') { $fm{$ending}=$mime; }
                 }                  }
             }              }
             close($fh);              close($fh);
Line 1947  sub plainname { Line 1948  sub plainname {
     $name=~s/^\s+//;      $name=~s/^\s+//;
     $name=~s/\s+$//;      $name=~s/\s+$//;
     $name=~s/\s+/ /g;      $name=~s/\s+/ /g;
     if ($name !~ /\S/) { $name=$uname.'@'.$udom; }      if ($name !~ /\S/) { $name=$uname.':'.$udom; }
     return $name;      return $name;
 }  }
   
Line 2198  sub fileembstyle { Line 2199  sub fileembstyle {
     return $fe{lc(shift(@_))};      return $fe{lc(shift(@_))};
 }  }
   
   sub filemimetype {
       return $fm{lc(shift(@_))};
   }
   
   
 sub filecategoryselect {  sub filecategoryselect {
     my ($name,$value)=@_;      my ($name,$value)=@_;
Line 2605  sub maketime { Line 2610  sub maketime {
 #########################################  #########################################
   
 sub findallcourses {  sub findallcourses {
       my ($roles) = @_;
       my %roles;
       if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
     my %courses;      my %courses;
     my $now=time;      my $now=time;
     foreach my $key (keys(%env)) {      foreach my $key (keys(%env)) {
  if ( $key=~m{^user\.role\.(\w+)\./(\w+)/(\w+)} ) {   if ( $key=~m{^user\.role\.(\w+)\./(\w+)/(\w+)} ) {
     my ($role,$domain,$id) = ($1,$2,$3);      my ($role,$domain,$id) = ($1,$2,$3);
     next if ($role eq 'ca' || $role eq 'aa');      next if ($role eq 'ca' || $role eq 'aa');
     my ($starttime,$endtime)=$env{$key};      next if (%roles && !exists($roles{$role}));
       my ($starttime,$endtime)=split(/\./,$env{$key});
             my $active=1;              my $active=1;
             if ($starttime) {              if ($starttime) {
  if ($now<$starttime) { $active=0; }   if ($now<$starttime) { $active=0; }
Line 3043  sub endbodytag { Line 3052  sub endbodytag {
     return $endbodytag;      return $endbodytag;
 }  }
   
   =pod
   
   =over 4
   
   =item * &standard_css()
   
   Returns a style sheet
   
   Inputs: (all optional)
               domain         -> force to color decorate a page for a specific
                                  domain
               function       -> force usage of a specific rolish color scheme
               bgcolor        -> override the default page bgcolor
   
   =back
   
   =cut
   
 sub standard_css {  sub standard_css {
     my ($function,$domain,$bgcolor) = @_;      my ($function,$domain,$bgcolor) = @_;
     my $function = &get_users_function() if (!$function);      $function  = &get_users_function() if (!$function);
     my $img =    &designparm($function.'.img',$domain);      my $img    = &designparm($function.'.img',   $domain);
     my $tabbg =  &designparm($function.'.tabbg',$domain);      my $tabbg  = &designparm($function.'.tabbg', $domain);
     my $font =   &designparm($function.'.font',$domain);      my $font   = &designparm($function.'.font',  $domain);
     my $sidebg = &designparm($function.'.sidebg',$domain);      my $sidebg = &designparm($function.'.sidebg',$domain);
     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);      my $pgbg   = $bgcolor ||
            &designparm($function.'.pgbg',  $domain);
     my $alink  = &designparm($function.'.alink',$domain);      my $alink  = &designparm($function.'.alink', $domain);
     my $vlink  = &designparm($function.'.vlink',$domain);      my $vlink  = &designparm($function.'.vlink', $domain);
     my $link   = &designparm($function.'.link',$domain);      my $link   = &designparm($function.'.link',  $domain);
     my $sans   = 'Arial,Helvetica,sans-serif';  
     my $data_table_head = $tabbg;      my $sans                 = 'Arial,Helvetica,sans-serif';
     my $data_table_light = '#EEEEEE';      my $data_table_head      = $tabbg;
     my $data_table_dark = '#DDD';      my $data_table_light     = '#EEEEEE';
       my $data_table_dark      = '#DDD';
     my $data_table_highlight = '#FFFF00';      my $data_table_highlight = '#FFFF00';
     my $mail_new = '#FFBB77';      my $mail_new             = '#FFBB77';
     my $mail_new_hover = '#DD9955';      my $mail_new_hover       = '#DD9955';
     my $mail_read = '#BBBB77';      my $mail_read            = '#BBBB77';
     my $mail_read_hover = '#999944';      my $mail_read_hover      = '#999944';
     my $mail_replied = '#AAAA88';      my $mail_replied         = '#AAAA88';
     my $mail_replied_hover = '#888855';      my $mail_replied_hover   = '#888855';
     my $mail_other = '#99BBBB';      my $mail_other           = '#99BBBB';
     my $mail_other_hover = '#669999';      my $mail_other_hover     = '#669999';
   
     return <<END;      return <<END;
 <style type="text/css">  <style type="text/css">
Line 3212  Inputs: $title - optional title for the Line 3240  Inputs: $title - optional title for the
         $args - optional arguments          $args - optional arguments
             force_register - if is true call registerurl so the remote is               force_register - if is true call registerurl so the remote is 
                              informed                               informed
             redirect - array ref of seconds before redirect occurs              redirect       -> array ref of seconds before redirect occurs
                                     url to redirect to                                      url to redirect to
                            (side effect of setting                              (side effect of setting 
                                $env{'internal.head.redirect'} to the url                                  $env{'internal.head.redirect'} to the url 
                                redirected too)                                 redirected too)
               domain         -> force to color decorate a page for a specific
                                  domain
               function       -> force usage of a specific rolish color scheme
               bgcolor        -> override the default page bgcolor
   
 =back  =back
   
 =cut  =cut
Line 3226  sub headtag { Line 3259  sub headtag {
           
     my $result =      my $result =
  '<head>'.   '<head>'.
  &standard_css().   &standard_css($args->{'function'},$args->{'domain'},
         $args->{'bgcolor'}).
  &font_settings().   &font_settings().
  &Apache::lonhtmlcommon::htmlareaheaders();   &Apache::lonhtmlcommon::htmlareaheaders();
   
Line 3393  sub start_page { Line 3427  sub start_page {
     my ($title,$head_extra,$args) = @_;      my ($title,$head_extra,$args) = @_;
     #&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') {      foreach my $arg ('redirect','force_register','domain','function',
        'bgcolor') {
  if (defined($args->{$arg})) {   if (defined($args->{$arg})) {
     $head_args{$arg} = $args->{$arg};      $head_args{$arg} = $args->{$arg};
  }   }
Removed from v.1.350  
changed lines
  Added in v.1.355

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