Annotation of loncom/interface/lonannounce.pm, revision 1.72

1.1       www         1: # The LearningOnline Network
1.2       www         2: # Announce
1.1       www         3: #
1.72    ! raeburn     4: # $Id: lonannounce.pm,v 1.71 2008/09/19 03:27:04 raeburn Exp $
1.1       www         5: #
1.3       www         6: # Copyright Michigan State University Board of Trustees
1.1       www         7: #
1.3       www         8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
1.1       www         9: #
1.3       www        10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
1.1       www        14: #
1.3       www        15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
                     28: 
1.2       www        29: package Apache::lonannounce;
1.1       www        30: 
                     31: use strict;
                     32: use Apache::Constants qw(:common);
1.3       www        33: use Apache::loncommon;
1.8       matthew    34: use Apache::lonhtmlcommon();
1.20      www        35: use Apache::lonlocal;
1.43      albertel   36: use Apache::lonnavmaps();
1.36      www        37: use Apache::lonrss();
1.34      albertel   38: use Apache::lonnet;
1.15      www        39: use HTML::Entities();
1.63      albertel   40: use LONCAPA qw(:match);
1.71      raeburn    41: use DateTime;
                     42: use DateTime::TimeZone;
1.3       www        43: 
1.12      www        44: my %todayhash;
1.16      www        45: my %showedcheck;
1.12      www        46: 
1.10      www        47: sub editfield {
                     48:     my ($r,$start,$end,$text)=@_;
                     49:     # Deal with date forms
                     50:     my $startdateform = &Apache::lonhtmlcommon::date_setter('anno',
                     51:                                                             'startdate',
                     52:                                                             $start);
                     53:     my $enddateform = &Apache::lonhtmlcommon::date_setter('anno',
                     54:                                                           'enddate',
                     55:                                                           $end);
1.55      albertel   56:     my $help=&Apache::loncommon::help_open_menu('Calendar Add Announcement','Calendar_Add_Announcement',274,'Communication Tools');
1.36      www        57:     my %lt=&Apache::lonlocal::texthash('post' => 'Post Announcement',
                     58: 				       'start' => 'Starting date',
                     59: 				       'end' => 'Ending date',
1.37      www        60: 				       'incrss' => 'Include in course RSS newsfeed');
1.36      www        61: 
1.10      www        62:     $r->print(<<ENDFORM);
1.25      www        63: $help
1.10      www        64: <form name="anno" method="post">
1.36      www        65: <input type="hidden" value='' name="action" />
                     66: <table><tr><td>$lt{'start'}:</td><td>$startdateform</td></tr>
                     67: <tr><td>$lt{'end'}:</td><td>$enddateform</td></tr></table>
1.10      www        68: <textarea name="msg" rows="4" cols="60">$text</textarea>
1.36      www        69: <br />
1.46      albertel   70: <label><input type="checkbox" name="rsspost" /> $lt{'incrss'}</label>
1.36      www        71: <br /><input type="button" onClick="trysubmit()" value="$lt{'post'}" /><hr />
1.10      www        72: ENDFORM
                     73: }
                     74: 
1.3       www        75: sub readcalendar {
                     76:     my $courseid=shift;
1.34      albertel   77:     my $coursenum=$env{'course.'.$courseid.'.num'};
                     78:     my $coursedom=$env{'course.'.$courseid.'.domain'};
1.69      raeburn    79:     if ($coursenum eq '' || $coursedom eq '') {
                     80:         my %courseinfo=&Apache::lonnet::coursedescription($courseid);
                     81:         if ($coursenum eq '' && exists($courseinfo{'num'})) {
                     82:             $coursenum = $courseinfo{'num'};
                     83:         }
                     84:         if ($coursedom eq '' && exists($courseinfo{'domain'})) {
                     85:             $coursedom = $courseinfo{'domain'};
                     86:         }
                     87:     }
                     88: 
1.3       www        89:     my %thiscal=&Apache::lonnet::dump('calendar',$coursedom,$coursenum);
                     90:     my %returnhash=();
1.42      albertel   91:     foreach my $item (keys(%thiscal)) {
                     92:         unless (($item=~/^error\:/) || ($thiscal{$item}=~/^error\:/)) {
1.64      albertel   93: 	    my ($start,$end)=split('_',$item);
                     94: 	    $returnhash{join("\0",$courseid,$start,$end)}=$thiscal{$item};
1.3       www        95:         }
                     96:     }
1.61      albertel   97:     my $can_see_hidden = ($env{'request.role.adv'} &&
                     98: 			  ($courseid eq $env{'request.course.id'}));
                     99:     
                    100:     my $navmap;
                    101:     if ($courseid eq $env{'request.course.id'}) {
                    102: 	$navmap = Apache::lonnavmaps::navmap->new();
                    103:     }
1.68      albertel  104: 
                    105:     my $resourcedata=
1.65      albertel  106: 	&Apache::lonnet::get_courseresdata($coursenum,$coursedom);
1.69      raeburn   107:     if (ref($resourcedata) ne 'HASH') {
                    108:         return %returnhash;
                    109:     } 
1.68      albertel  110:     foreach my $thiskey (keys(%$resourcedata)) {
                    111: 	if ($resourcedata->{$thiskey.'.type'}=~/^date/) {
1.53      www       112: 	    my ($course,$middle,$part,$name)=
1.68      albertel  113: 		($thiskey=~/^(\Q$courseid\E)\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
                    114: 
1.56      albertel  115: 	    my %data = ( 'section' => &mt('All Students'));
1.53      www       116: 	    if ($middle=~/^\[(.*)\]\./) {
                    117: 		my $sec=$1;
                    118: 		# if we have a section don't show ones that aren't ours
                    119: 		if ($env{'request.course.sec'} &&
                    120: 		    $env{'request.course.sec'} ne $sec) { next; }
                    121: 		# if a student without a section don't show any section ones
                    122: 		if (!$env{'request.role.adv'} &&
                    123: 		    !$env{'request.course.sec'}) { next; }
1.56      albertel  124: 		$data{'section'}=&mt('Group/Section').': '.$1;
1.53      www       125: 		$middle=~s/^\[(.*)\]\.//;
                    126: 	    }
                    127: 	    $middle=~s/\.$//;
1.56      albertel  128: 	    $data{'realm'}=&mt('All Resources');
1.53      www       129: 	    if ($middle eq '___(all)') {
                    130: 		if (!$can_see_hidden && !$navmap) {
                    131: 		    next;
                    132: 		}
                    133: 	    } elsif ($middle=~/^(.+)\_\_\_\(all\)$/) {
                    134: 		my $map_url=$1;
                    135: 		if (!$can_see_hidden && !$navmap) {
                    136: 		    next;
                    137: 		}
                    138: 		if (!$can_see_hidden) {
                    139: 		    my $res = $navmap->getResourceByUrl($map_url);
1.68      albertel  140: 		    if ($res && $res->randomout()) {
                    141: 			next;
                    142: 		    }
1.26      www       143: 		}
1.56      albertel  144: 		$data{'realm'}=&mt('Folder/Map');
                    145: 		$data{'url'} = $map_url;
1.53      www       146: 	    } elsif ($middle) {
                    147: 		if (!$can_see_hidden && !$navmap) {
                    148: 		    next;
1.26      www       149: 		}
1.53      www       150: 		if (!$can_see_hidden) {
                    151: 		    my $res = $navmap->getBySymb($middle);
1.68      albertel  152: 		    if ($res && $res->randomout()) {
                    153: 			next;
                    154: 		    }
1.53      www       155: 		}
1.56      albertel  156: 		$data{'realm'} = &mt('Resource');
                    157: 		$data{'symb'} = $middle;
1.53      www       158: 	    }
1.56      albertel  159: 	    $data{'datetype'} = $name;
1.53      www       160: 	    if ($name eq 'duedate') { 
1.56      albertel  161: 		$data{'datetype'} = &mt('Due'); 
1.28      www       162: # see if accidentally answerdate is before duedate
1.53      www       163: 		my $answerkey=$thiskey;
                    164: 		$answerkey=~s/duedate$/answerdate/;
1.68      albertel  165: 		if ($resourcedata->{$thiskey}>$resourcedata->{$answerkey}) {
1.56      albertel  166: 		    $data{'datetype'} = &mt('Due and Answer Available');
1.28      www       167: 		}
1.53      www       168: 	    }
1.56      albertel  169: 	    if ($name eq 'opendate' 
                    170: 		|| $name eq 'contentopen' ) {
                    171: 		$data{'datetype'}=&mt('Opening');
                    172: 	    }
                    173: 	    if ($name eq 'contentclose') {
                    174: 		$data{'datetype'}=&mt('Closing');
                    175: 	    }
1.53      www       176: 	    if ($name eq 'answerdate') {
1.28      www       177: # see if accidentally answerdate is before duedate
1.53      www       178: 		my $duekey=$thiskey;
                    179: 		$duekey=~s/answerdate$/duedate/;
1.68      albertel  180: 		if ($resourcedata->{$duekey}>$resourcedata->{$thiskey}) {
1.28      www       181: # forget it
1.53      www       182: 		    next;
                    183: 		} 
1.56      albertel  184: 		$data{'datetype'}=&mt('Answer Available'); 
1.53      www       185: 	    }
1.64      albertel  186: 	    $returnhash{join("\0",$courseid,
1.68      albertel  187: 			     $resourcedata->{$thiskey},
                    188: 			     $resourcedata->{$thiskey})}=\%data;
1.26      www       189: 	}
                    190:     }
1.3       www       191:     return %returnhash;
                    192: }
                    193: 
                    194: sub emptycell {
1.49      albertel  195:     return '<td class="LC_calendar_day_empty">&nbsp;</td>';
1.3       www       196: }
                    197: 
                    198: sub normalcell {
1.56      albertel  199:     my ($day,$month,$year,$items_ref)=@_;
1.51      albertel  200:     my $output;
1.56      albertel  201:     my @items=&order($items_ref);
1.40      albertel  202:     foreach my $item (@items) {
                    203:         if ($item) {
1.56      albertel  204: 	    my ($courseid,$start,$end,$msg)=@$item;
                    205: 	    my $internalflag= (ref($msg)) ? 1 : 0;
                    206: 	    $msg = &display_msg($msg);
1.34      albertel  207:             my $fullmsg=&mt('Calendar Announcement for ').$env{'course.'.$courseid.'.description'}.
1.32      www       208: 		'\n'.&Apache::lonlocal::locallocaltime($start);
1.26      www       209: 	    if ($start!=$end) {
                    210: 		$fullmsg.=' - '.&Apache::lonlocal::locallocaltime($end);
                    211: 	    }
1.32      www       212: 	    $fullmsg.=':\n'.$msg;
1.56      albertel  213: 	    $fullmsg=~s/[\n\r]/\\n/gs;
                    214:             $fullmsg=&HTML::Entities::encode($fullmsg,'<>&"\'');
                    215:             $fullmsg=~s/&/\\&/g;
                    216: 	    my $short_msg = substr($msg,0,20).((length($msg) > 20)?'...':'');
                    217: 	    if (defined($output)) { $output.='<br />'; }
1.34      albertel  218:             if ($courseid eq $env{'request.course.id'}) {
                    219:               if ((&Apache::lonnet::allowed('srm',$env{'request.course.id'}))
1.19      www       220:                && (!$showedcheck{$start.'_'.$end})
1.34      albertel  221: 	       && ($env{'form.pickdate'} ne 'yes')
1.26      www       222: 	       && (!$internalflag)) {
1.5       www       223:                $output.='<input type="checkbox" name="remove_'.$start.'_'.
                    224: 		   $end.'">';
1.16      www       225:                $showedcheck{$start.'_'.$end}=1;
1.5       www       226: 	      }
                    227: 	    }
                    228:             $output.='<a href="javascript:alert('."'$fullmsg'".')">'.
1.51      albertel  229: 	       $short_msg.'</a>';
1.4       www       230:        }
                    231:     }
1.49      albertel  232:     return '<td class="LC_calendar_day'.
1.12      www       233: 	((($day eq $todayhash{'day'}) &&
                    234:           ($month eq $todayhash{'month'}) &&
1.49      albertel  235:           ($year eq $todayhash{'year'}))?'_current':'').
                    236:            '" ><b>'.&picklink($day,$day,$month,$year).'</b><br />'.$output.'</td>';
1.3       www       237: }
                    238: 
1.11      www       239: sub plaincell {
1.56      albertel  240:     my ($items_ref)=@_;
1.51      albertel  241:     my $output;
1.56      albertel  242:     my @items=&order($items_ref);
1.40      albertel  243:     foreach my $item (@items) {
1.56      albertel  244:         if (ref($item)) {
                    245: 	    my ($courseid,$start,$end,$msg)=@$item;
1.34      albertel  246:             my $fullmsg=&mt('Calendar Announcement for ').$env{'course.'.$courseid.'.description'}.
1.32      www       247: 		'\n'.&Apache::lonlocal::locallocaltime($start);
1.26      www       248: 	    if ($start!=$end) {
                    249: 		$fullmsg.=' - '.&Apache::lonlocal::locallocaltime($end);
                    250: 	    }
1.56      albertel  251: 	    $msg = &display_msg($msg);
1.32      www       252: 	    $fullmsg.=':\n'.$msg;
                    253:  	    $fullmsg=~s/[\n\r]/\\n/gs;
1.15      www       254:             $fullmsg=&HTML::Entities::encode($fullmsg,'<>&"\'');
                    255:             $fullmsg=~s/&/\\&/g;
1.51      albertel  256: 	    my $short_msg = substr($msg,0,80).((length($msg) > 80)?'...':'');
                    257: 	    if (defined($output)) { $output.='<br />'; }
1.11      www       258:             $output.='<a href="javascript:alert('."'$fullmsg'".')">'.
1.51      albertel  259: 	       $short_msg.'</a>';
1.11      www       260:        }
                    261:     }
                    262:     return $output;
                    263: }
                    264: 
                    265: sub listcell {
1.56      albertel  266:     my ($items_ref)=@_;
1.11      www       267:     my $output='';
1.56      albertel  268:     my @items=&order($items_ref);
1.40      albertel  269:     foreach my $item (@items) {
1.56      albertel  270:         if (ref($item)) {
                    271: 	    my ($courseid,$start,$end,$msg)=@$item;
                    272: 	    my $fullmsg=&Apache::lonlocal::locallocaltime($start);
1.26      www       273: 	    if ($start!=$end) {
                    274: 		$fullmsg.=&mt(' to ').
                    275: 		    &Apache::lonlocal::locallocaltime($end);
                    276: 	    }
1.56      albertel  277:             $fullmsg.=':<br /><b>'.&display_msg($msg).'</b>';
1.11      www       278:             $output.='<li>'.$fullmsg.'</li>';
                    279:        }
                    280:     }
                    281:     return $output;
                    282: }
                    283: 
1.40      albertel  284: sub order {
1.56      albertel  285:     my ($items)=@_;
                    286:     return sort {
                    287: 	my ($astart,$aend)=$a->[1,2];
                    288: 	my ($bstart,$bend)=$b->[1,2];
1.40      albertel  289: 	if ($astart != $bstart) {
                    290: 	    return $astart <=> $bstart;
                    291: 	}
                    292: 	return $aend <=> $bend;
1.56      albertel  293:     } @$items;
1.40      albertel  294: }
                    295: 
1.3       www       296: sub nextday {
1.71      raeburn   297:     my ($tk,%th)=@_;
                    298:     my ($incmonth,$incyear);
                    299:     if ($th{'day'} > 27) {
                    300:         if ($th{'month'} == 2) {
                    301:             if ($th{'day'} == 29) { 
                    302:                 $incmonth = 1;
                    303:             } elsif ($th{'day'} == 28) {
                    304:                 if (!&is_leap_year($tk)) {
                    305:                    $incmonth = 1;
                    306:                 }
                    307:             }
                    308:         } elsif (($th{'month'} == 4) || ($th{'month'} == 6) || 
                    309:                  ($th{'month'} == 9) || ($th{'month'} == 11)) {
                    310:             if ($th{'day'} == 30) {
                    311:                 $incmonth = 1;
                    312:             }
                    313:         } elsif ($th{'day'} == 31) {
                    314:             if ($th{'month'} == 12) {
                    315:                 $incyear = 1;
                    316:             } else {
                    317:                 $incmonth = 1;
                    318:             }
                    319:         }
                    320:         if ($incyear) {
                    321:             $th{'day'} = 1;
                    322:             $th{'month'} = 1;
                    323:             $th{'year'}++;
                    324:         } elsif ($incmonth) {
                    325:             $th{'day'} = 1;
                    326:             $th{'month'}++;
                    327:         } else {
                    328:             $th{'day'}++;
                    329:         }
                    330:     } else {
                    331:         $th{'day'}++;
                    332:     }
1.3       www       333:     return (&Apache::loncommon::maketime(%th),$th{'month'});
                    334: }
                    335: 
1.71      raeburn   336: sub is_leap_year {
                    337:     my ($thistime) = @_;
                    338:     my ($is_leap,$timezone,$dt);
                    339:     $timezone = &Apache::lonlocal::gettimezone();
                    340:     eval {
                    341:         $dt = DateTime->from_epoch(epoch => $thistime)
                    342:                       ->set_time_zone($timezone);
                    343:     };
                    344:     if (!$@) {
                    345:         $is_leap = $dt->is_leap_year;
                    346:     }
                    347:     return $is_leap;
                    348: }
                    349: 
1.56      albertel  350: sub display_msg {
                    351:     my ($msg) = @_;
                    352: 
                    353:     # if it's not a ref, it's an instructor provided message
                    354:     return $msg if (!ref($msg));
                    355: 
                    356:     my $output = $msg->{'datetype'}. ': '.$msg->{'realm'};
                    357:     if (exists($msg->{'url'})) {
1.59      www       358: 	my $displayurl=&Apache::lonnet::gettitle($msg->{'url'});
                    359: 	if ($msg->{'url'}!~/\Q$displayurl\E$/) {
                    360: 	    $output .= ' - '.$displayurl;
                    361: 	}
1.56      albertel  362:     }
                    363:     if (exists($msg->{'symb'})) {
1.59      www       364: 	my $displaysymb=&Apache::lonnet::gettitle($msg->{'symb'});
                    365: 	if ($msg->{'symb'}!~/\Q$displaysymb\E$/) {
                    366: 	    $output .= ' - '.$displaysymb;
                    367: 	}
1.56      albertel  368:     }
                    369:     $output .= ' ('.$msg->{'section'}.') ';
                    370:     return $output;
                    371: }
                    372: 
1.3       www       373: sub showday {
1.11      www       374:     my ($tk,$mode,%allcal)=@_;
1.3       www       375:     my %th=&Apache::loncommon::timehash($tk);
1.71      raeburn   376:     my ($nextday,$nextmonth)=&nextday($tk,%th);
1.56      albertel  377:     my @outp;
1.27      www       378:     if ($mode) {
                    379: 	my $oneday=24*3600;
                    380: 	$tk-=$oneday;
                    381: 	$nextday+=$oneday;
                    382:     }
1.40      albertel  383:     foreach my $item (keys(%allcal)) {
1.64      albertel  384: 	my ($courseid,$startdate,$enddate)= split("\0",$item);
                    385: 	if (($startdate<$nextday) && ($enddate>=$tk))  {
                    386: 	    push(@outp,[$courseid,$startdate,$enddate,$allcal{$item}]);
1.3       www       387:         }
                    388:     }
1.11      www       389:     unless ($mode) {
1.12      www       390:        return ($nextday,$nextmonth,&normalcell(
1.56      albertel  391:                $th{'day'},$th{'month'},$th{'year'},\@outp));
                    392:    } elsif (@outp) {
1.11      www       393:        if ($mode==1) {
1.56      albertel  394:           return '<br />'.&plaincell(\@outp);
1.11      www       395:       } else {
1.56      albertel  396:           return '<ul>'.&listcell(\@outp).'</ul>';
1.11      www       397:       }
                    398:    } else {
                    399:        return '';
                    400:    }
1.3       www       401: }
1.1       www       402: 
1.19      www       403: sub picklink {
                    404:     my ($text,$day,$month,$year)=@_;
1.34      albertel  405:     if ($env{'form.pickdate'} eq 'yes') {
1.19      www       406: 	return '<a href="javascript:dialin('.$day.','.$month.','.$year.')">'.
                    407: 	    $text.'</a>';
                    408:     } else {
                    409: 	return $text;
                    410:     }
                    411: }
                    412: 
                    413: sub dialscript {
                    414:     return (<<ENDDIA);
                    415: <script language="Javascript">
                    416: function dialin(day,month,year) {
1.34      albertel  417: 	opener.document.$env{'form.formname'}.$env{'form.element'}\_year.value=year;
                    418:     var slct=opener.document.$env{'form.formname'}.$env{'form.element'}\_month;
1.19      www       419:     var i;
                    420:     for (i=0;i<slct.length;i++) {
                    421:         if (slct.options[i].value==month) { slct.selectedIndex=i; }
                    422:     }
1.34      albertel  423:     opener.document.$env{'form.formname'}.$env{'form.element'}\_day.value=day;
                    424:     opener.$env{'form.element'}\_checkday();
1.19      www       425:     self.close();
                    426: }
                    427: </script>
                    428: ENDDIA
                    429: }
1.52      www       430: # ----------------------------------------------------- Summarize all calendars
                    431: sub get_all_calendars {
                    432:     my %allcal=();
1.62      raeburn   433:     my %courses = &Apache::loncommon::findallcourses();
                    434:     foreach my $course (sort(keys(%courses))) {
1.52      www       435: 	%allcal=(%allcal,&readcalendar($course));
                    436:     }
                    437:     return %allcal;
                    438: }
                    439: 
                    440: sub output_ics_file {
                    441:     my ($r)=@_;
                    442: # RFC 2445 wants CRLF
                    443:     my $crlf="\015\012";
                    444: # Header
                    445:     $r->print("BEGIN:VCALENDAR$crlf");
                    446:     $r->print("VERSION:2.0$crlf");
                    447:     $r->print("PRODID:-//LONCAPA//LONCAPA Calendar Output//EN$crlf");
                    448:     my %allcal=&get_all_calendars();
                    449:     foreach my $event (keys(%allcal)) {
1.64      albertel  450: 	my ($courseid,$startdate,$enddate)= split('\0',$event);
1.53      www       451: 	my $uid=$event;
                    452: 	$uid=~s/[\W\_]/-/gs;
                    453: 	$uid.='@loncapa';
1.56      albertel  454: 	my $summary=&display_msg($allcal{$event});
1.53      www       455: 	$summary=~s/\s+/ /gs;
                    456:         $summary=$env{'course.'.$courseid.'.description'}.': '.$summary;
1.52      www       457: 	$r->print("BEGIN:VEVENT$crlf");
                    458: 	$r->print("DTSTART:".&Apache::loncommon::utc_string($startdate).$crlf);
                    459: 	$r->print("DTEND:".&Apache::loncommon::utc_string($enddate).$crlf);
1.53      www       460: 	$r->print("SUMMARY:$summary$crlf");
                    461: 	$r->print("UID:$uid$crlf");
1.52      www       462: 	$r->print("END:VEVENT$crlf");
                    463:     }
                    464: # Footer
                    465:     $r->print("END:VCALENDAR$crlf");
                    466: }
1.19      www       467: 
1.71      raeburn   468: sub show_timezone {
                    469:     my $tzone = &Apache::lonlocal::gettimezone();
                    470:     my $dt = DateTime->now();
                    471:     my $tz = DateTime::TimeZone->new( name => $tzone );
                    472:     return &mt('([_1] time zone)',$tz->short_name_for_datetime($dt));
                    473: }
                    474: 
1.1       www       475: sub handler {
                    476:     my $r = shift;
1.52      www       477:     if ($r->uri=~/\.(ics|ical)$/) {
                    478:         &Apache::loncommon::content_type($r,'text/calendar');
                    479: 	&output_ics_file($r);
                    480: 	return OK;
                    481:     }
1.21      www       482:     &Apache::loncommon::content_type($r,'text/html');
1.1       www       483:     $r->send_http_header;
                    484:     return OK if $r->header_only;
                    485: 
1.3       www       486: # ---------------------------------------------------------- Get time right now
                    487:     my $today=time;
1.12      www       488:     %todayhash=&Apache::loncommon::timehash($today);
1.16      www       489: # ----------------------------------------------------------------- Check marks
1.49      albertel  490:     undef(%showedcheck);
1.3       www       491: # ---------------------------------------------------------- Get month and year
                    492:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.19      www       493:                              ['month','year','pickdate','formname','element']);
1.3       www       494: # --------------------------------------------------- Decide what month to show
                    495:     my $year=$todayhash{'year'};
1.34      albertel  496:     if ($env{'form.year'}) { $year=$env{'form.year'}; }
1.3       www       497:     my $month=$todayhash{'month'};
1.34      albertel  498:     if ($env{'form.month'}) { $month=$env{'form.month'}; }
1.18      www       499: 
                    500: # ---------------------------------------------- See if we are in pickdate mode
1.34      albertel  501:     my $pickdatemode=($env{'form.pickdate'} eq 'yes');
                    502:     my $pickinfo='&pickdate=yes&formname='.$env{'form.formname'}.
                    503: 	'&element='.$env{'form.element'};
1.3       www       504: # --------------------------------------------- Find out first day of the month
                    505: 
1.71      raeburn   506:     my $tk = &Apache::loncommon::maketime( 'day' => 1,
                    507:                                            'month'=> $month,
                    508:                                            'year' => $year, 
                    509:                                            'hour' => 0,
                    510: 				           'minute' => 0, 
                    511:                                            'second' => 0);
                    512:     my %firstday = &Apache::loncommon::timehash($tk);
1.3       www       513:     my $weekday=$firstday{'weekday'};
1.71      raeburn   514: 
1.3       www       515: # ------------------------------------------------------------ Print the screen
1.47      albertel  516:     my $js = <<ENDDOCUMENT;
                    517: <script type="text/javascript">
1.3       www       518: 
                    519:     function trysubmit() {
                    520:         document.anno.action.value="new";
                    521: 	document.anno.submit();
                    522:     }
                    523: 
                    524:     function removesub() {
                    525:         document.anno.action.value="del";
                    526: 	document.anno.submit();
                    527:     }
                    528: </script>
1.1       www       529: ENDDOCUMENT
1.47      albertel  530: 
1.18      www       531:     if ($pickdatemode) {
                    532: # no big header in pickdate mode
1.47      albertel  533: 	$r->print(&Apache::loncommon::start_page("Pick a Date",$js,
                    534: 						 {'only_body' => 1,}).
1.19      www       535: 		  &dialscript().
1.18      www       536: 		  '<font size="1">');
                    537:     } else {
1.47      albertel  538:        $r->print(&Apache::loncommon::start_page("Announcements and Calendar",
                    539: 						$js));
1.18      www       540:     }
1.3       www       541: # does this user have privileges to post, etc?
                    542:     my $allowed=0;
1.34      albertel  543:     if ($env{'request.course.id'}) {
                    544:        $allowed=&Apache::lonnet::allowed('srm',$env{'request.course.id'});
1.3       www       545:     }
1.17      www       546: # does this user have privileges to post to servers?
                    547:     my $serverpost=0;
1.34      albertel  548:     if ($env{'request.role.domain'}) {
1.17      www       549: 	$serverpost=&Apache::lonnet::allowed('psa',
1.34      albertel  550: 					     $env{'request.role.domain'});
1.17      www       551:     } else {
                    552: 	$serverpost=&Apache::lonnet::allowed('psa','/');
                    553:     }
1.18      www       554: # -------------------------------- BUT: do no fancy stuff when in pickdate mode
                    555:     if ($pickdatemode) { 
                    556: 	$serverpost=0; 
                    557: 	$allowed=0;
                    558:     }
1.17      www       559: # ------------------------------------------------------------ Process commands
                    560:     if ($serverpost) {
1.34      albertel  561: 	if ($env{'form.serveraction'}) {
1.42      albertel  562: 	    foreach my $key (keys(%env)) {
                    563: 		if ($key=~/^form\.postto\_(\w+)/) {
1.17      www       564: 		    $r->print( 
                    565: 			'<br />Posting '.$1.': '.&Apache::lonnet::postannounce
1.34      albertel  566: 			($1,$env{'form.serverannnounce'}));
1.17      www       567: 		}
                    568: 	    }
                    569: 	}
                    570: 	$r->print(<<SERVERANNOUNCE);
                    571: <form name="serveranno" method="post">
                    572: <h3>Post Server Announcements</h3>
                    573: Post announcements to the system login and roles screen<br />
                    574: <i>(leave blank to delete announcement)</i><br />
                    575: <textarea name="serverannnounce" cols="60" rows="5"></textarea><br />
                    576: Check machines:<br />
                    577: SERVERANNOUNCE
                    578: # list servers
1.66      albertel  579:     my %hostname = &Apache::lonnet::all_hostnames();
                    580:     foreach my $host (sort(keys(%hostname))) {
1.67      albertel  581: 	if (&Apache::lonnet::allowed('psa',
                    582: 				     &Apache::lonnet::host_domain($host))) {
1.60      albertel  583: 	    $r->print ('<br /><label><input type="checkbox" name="postto_'.$host.'" /> '.
1.66      albertel  584: 		       $host.' <tt>'.$hostname{$host}.'</tt> '.
                    585: 		       '</label><a href="http://'.$hostname{$host}.
1.70      www       586: 		       '/announcement.txt?time='.time.'" target="annowin">current</a>');
1.17      www       587: 	}
                    588:     }
                    589:     $r->print(
                    590:   '<br /><input type="submit" name="serveraction" value="Post"></form><hr />');
                    591:     }
1.3       www       592:     if ($allowed) {
1.34      albertel  593:         my $coursenum=$env{'course.'.$env{'request.course.id'}.'.num'};
                    594:         my $coursedom=$env{'course.'.$env{'request.course.id'}.'.domain'};
1.3       www       595: # ----------------------------------------------------- Store new submitted one
1.34      albertel  596:         if ($env{'form.action'} eq 'new') {
1.9       www       597: 	    my $startdate = 
                    598: 		&Apache::lonhtmlcommon::get_date_from_form('startdate');
                    599: 	    my $enddate   = 
                    600: 		&Apache::lonhtmlcommon::get_date_from_form('enddate');
                    601: 	    unless ($startdate=~/^\d+$/) { $startdate=time; }
                    602:             unless ($enddate=~/^\d+$/) { $enddate=$startdate+1; }
                    603:             if ($startdate>$enddate) {
                    604: 		my $buffer=$startdate;
                    605: 		$startdate=$enddate;
                    606: 		$enddate=$buffer;
                    607:             }
1.3       www       608: 	    &Apache::lonnet::put('calendar',{ 
1.9       www       609: 		$startdate.'_'.$enddate => 
1.34      albertel  610: 		    $env{'form.msg'} },$coursedom,$coursenum);
1.36      www       611: 	    if ($env{'form.rsspost'}) {
                    612:                &Apache::lonrss::addentry($coursenum,$coursedom,'Course_Announcements',
                    613: 					 &mt('Event from [_1] to [_2]',
                    614: 					     &Apache::lonlocal::locallocaltime($startdate),
                    615: 					     &Apache::lonlocal::locallocaltime($enddate)),
                    616: 					 $env{'form.msg'},'/adm/announcements','public');
                    617: 	   }
1.3       www       618:         }
                    619: # ---------------------------------------------------------------- Remove items
1.34      albertel  620:         if ($env{'form.action'} eq 'del') {
1.3       www       621: 	    my @delwhich=();
1.42      albertel  622:             foreach my $key (keys(%env)) {
                    623: 		if ($key=~/^form\.remove\_(.+)$/) {
1.3       www       624: 		    push(@delwhich,$1);
                    625:                 }
                    626:             }
                    627:             &Apache::lonnet::del('calendar',\@delwhich,$coursedom,$coursenum);
                    628:         }
                    629: # -------------------------------------------------------- Form to post new one
                    630:         my %tomorrowhash=%todayhash;
                    631:         $tomorrowhash{'day'}++;
                    632:         my $tomorrow=&Apache::loncommon::maketime(%tomorrowhash);
                    633:         
1.10      www       634:         &editfield($r,$today,$tomorrow,'');
1.3       www       635:     }
1.5       www       636: # ----------------------------------------------------- Summarize all calendars
1.52      www       637:     my %allcal=&get_all_calendars();
1.5       www       638: # ------------------------------- Initialize table and forward backward buttons
1.3       www       639:     my ($pm,$py,$fm,$fy)=($month-1,$year,$month+1,$year);
                    640:     if ($pm<1) { ($pm,$py)=(12,$year-1); }
                    641:     if ($fm>12){ ($fm,$fy)=(1,$year+1); }
1.14      www       642: 
1.20      www       643:     $r->print('<h1>'.('',&mt('January'),&mt('February'),&mt('March'),
                    644: 		      &mt('April'),&mt('May'),
                    645: 		      &mt('June'),&mt('July'),&mt('August'),
                    646:                       &mt('September'),&mt('October'),
                    647:                       &mt('November'),&mt('December'))[$month].' '.
1.71      raeburn   648: 	              $year.' '.&show_timezone().'</h1>');
1.13      www       649: # Reached the end of times, give up
                    650:     if (($year<1970) || ($year>2037)) {
                    651: 	$r->print('<h3>No calendar available for this date.</h3>'.
                    652:  '<a href="/adm/announcements?month='.$todayhash{'month'}.
1.47      albertel  653:  '&year='.$todayhash{'year'}.'">Current Month</a>'.
                    654: 		  &Apache::loncommon::end_page());
1.13      www       655: 	return OK;
                    656:     }
1.49      albertel  657: 
                    658:     my $class = "LC_calendar";
                    659:     if ($env{'form.pickdate'} eq 'yes') {
                    660: 	$class .= " LC_calendar_pickdate";
                    661:     }
1.71      raeburn   662: # ------------------------------------------------ Determine first day of a week
                    663:     my $datelocale =  &Apache::lonlocal::getdatelocale();
                    664:     my $days_in_week = 7;
                    665:     my $startweek = 0;
                    666:     if (ref($datelocale)) {
                    667:         $startweek = $datelocale->first_day_of_week();
                    668:         if ($startweek == $days_in_week)  { $startweek = 0; }
                    669:     }
                    670:     my @days = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
                    671:     my @localdays;
                    672:     if ($startweek == 0) {
                    673:         @localdays = @days;
                    674:     } else {
                    675:         my $endday = $days_in_week - $startweek;
                    676:         for (my $i=0; $i<$days_in_week; $i++) {
                    677:             if ($i < $endday) {
                    678:                 $localdays[$i] = $days[$i+$startweek];
                    679:             } else {
                    680:                 $localdays[$i] = $days[$i-$endday];
                    681:             }
                    682:         }
                    683:     }
                    684: 
                    685: # ----------------------------------------------------------- Weekday in locale
                    686:     my $loc_weekday = $weekday - $startweek;
                    687:     if ($loc_weekday < 0) {
                    688:         $loc_weekday += $days_in_week; 
                    689:     }
                    690: 
1.13      www       691:     $r->print(
1.18      www       692:  '<a href="/adm/announcements?month='.$pm.'&year='.$py.
1.20      www       693:  ($pickdatemode?$pickinfo:'').'">'.&mt('Previous Month').'</a> '.
1.18      www       694:  '<a href="/adm/announcements?month='.$fm.'&year='.$fy.
1.20      www       695:  ($pickdatemode?$pickinfo:'').'">'.&mt('Next Month').'</a>'.
1.12      www       696:  '&nbsp;&nbsp;&nbsp;<a href="/adm/announcements?month='.$todayhash{'month'}.
1.18      www       697:  '&year='.$todayhash{'year'}.
1.20      www       698:  ($pickdatemode?$pickinfo:'').'">'.&mt('Current Month').'</a><p>'.
1.71      raeburn   699:         '<table class="'.$class.'" cols="7" rows="5"><tr>');
                    700:     for (my $i=0; $i<@localdays; $i++) {
                    701:         $r->print('<th>'.&mt($localdays[$i]).'</th>');
                    702:     }
                    703:     $r->print('</tr>');
1.3       www       704: 
                    705:     my $outp;
                    706:     my $nm;
                    707: 
                    708: # ---------------------------------------------------------------- Actual table
                    709:     $r->print('<tr>');
1.71      raeburn   710:     for (my $i=0;$i<$loc_weekday;$i++) { $r->print(&emptycell); }
                    711:     for (my $i=$loc_weekday;$i<=6;$i++) {
1.11      www       712:         ($tk,$nm,$outp)=&showday($tk,0,%allcal);
1.3       www       713:         $r->print($outp);
                    714:     }
                    715:     $r->print('</tr>');
                    716: 
1.71      raeburn   717:     my $lastrow = 0;
                    718:     my $lastday = 0;
1.23      www       719:     for (my $k=0;$k<=4;$k++) {
1.71      raeburn   720:         if (!$lastrow) {
                    721:             $r->print('<tr>');
                    722:             for (my $i=0;$i<=6;$i++) {
                    723:                 if ($lastday) {
                    724:                     $outp = &emptycell();
                    725:                 } else {
                    726:                     my $currtk = $tk;
                    727:                     ($tk,$nm,$outp)=&showday($tk,0,%allcal);
                    728:                     if ($month!=$nm) { $lastday = 1; }
                    729:                 }
                    730:                 $r->print($outp);
                    731:             }
                    732:             if ($lastday) {
                    733:                 $lastrow = 1;
                    734:             }
                    735:             $r->print('</tr>');
1.3       www       736:         }
                    737:     }
                    738: # ------------------------------------------------------------------- End table
1.7       matthew   739:     $r->print('</table>');
1.16      www       740: # ----------------------------------------------------------------- Check marks
1.49      albertel  741:     undef(%showedcheck);
1.16      www       742: # --------------------------------------------------------------- Remove button
1.24      www       743:     if ($allowed) { $r->print('<input type="button" onClick="removesub()" value="Remove Checked Entries">'.
                    744: 			      &Apache::loncommon::help_open_topic('Calendar_Remove_Announcement').'</form>'); }
1.7       matthew   745:     $r->print('<p>'.
1.18      www       746:  '<a href="/adm/announcements?month='.$pm.'&year='.$py.
1.20      www       747:  ($pickdatemode?$pickinfo:'').'">'.&mt('Previous Month').'</a> '.
1.18      www       748:  '<a href="/adm/announcements?month='.$fm.'&year='.$fy.
1.20      www       749:  ($pickdatemode?$pickinfo:'').'">'.&mt('Next Month').'</a>'.
1.12      www       750:  '&nbsp;&nbsp;&nbsp;<a href="/adm/announcements?month='.$todayhash{'month'}.
1.18      www       751:  '&year='.$todayhash{'year'}.
1.20      www       752:  ($pickdatemode?$pickinfo:'').'">'.&mt('Current Month').'</a></p>'.
1.47      albertel  753:  ($pickdatemode?'</font>':'').&Apache::loncommon::end_page());
1.53      www       754:     $r->print('<a href="/adm/announcements.ics">'.&mt('Download your Calendar as iCalendar File').'</a>');
1.1       www       755:     return OK;
                    756: } 
                    757: 
                    758: 1;
                    759: __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.