Всем интересно узнать, как на лету генерировать календарь для своего сайта. Например, календарь событий для блога или, как в этом случае, календарь новинок ПО для софт-каталога ProtoPlex. Когда я задался целью создать такой календарь, под рукой не оказалось ничего доступного и пришлось изобретать свой собственный велосипед. Может это и не лучшее решение, но хотя бы рабочее. Написан алгоритм был года два-три назад, т.е. очень давно. Не сомневаюсь, что сейчас я могу написать более быстрый и изящный алгоритм, но тогда я был способен родить только этот :) В общем, приступаю к разжевыванию.

В моих скриптах раньше была генерация календаря на лету, теперь же календарь генерится только при изменениях БД, т.е. только когда есть смысл его генерить, и пишется в файл. Выдавающие срипты просто берут готовый HTML-код из файла. Это снижает нагрузку на сервер и увеличивает скорострельность сайта. Поэтому я предлагаю и вам такое решение.

Для выполнения этого алгоритма нужен перловый модуль Time-Local, поэтому не забудьте в скрипте добавить строчку use Time::Local;. Сколько я по хостингам раньше не бегал, этот модуль был у всех. Он, скорее всего, стандартный, поэтому париться из-за его отсутствия вряд ли придется. Календарь за определенный месяц генерируется функцией &calendar($time), которой в качестве параметра передается строчка вида 2002-10-1 12:00:00, т.е. дата первого числа выводимого месяца. Это вносит некую универсальность в функцию, потому как можно без труда вывести календарь не только за текущий месяц, но и за любой другой. Функция str2time2 ($) нужна для тупого преобразования строчек с датой в секунды с начала эпохи. Функция довольно полезная не только при построении календаря. Я ее использую и в других операциях.

Генерируемый календарь подключать можно обычным образом. Читаем файл cal_soft.txt и выдаем в браузер на нужной позиции.

open (F,"cal_soft.txt");
my @D=;
close F;
$paga.="@D";

Теперь побежим по функциям с краткими пояснениями. Особо из себя учителя строить не буду, умные головы и так все понять должны. Те, кто не поймет, спрашивайте в комментах к материалу, допишу, что будет непонятно.

sub rewrite_calendar # пишет календарик на 2 месяца в файл
{
my $paga222=''; # создаем переменную для кода календаря
open (F,">cal_soft.txt"); # открыли файл
$paga222.= qq~<center><br>
<table>
<tr><td>~; # сгенерили теги
my ($mon2,$year2); # узнали предыд. месяц
my ($mon,$year)=((localtime(time))[4]+1,(localtime(time))[5]+1900); 
if ($mon>1) 
{$mon2=$mon-1;$year2=$year;} # Если тек. не январь, то обычный метод
if ($mon==1) 
{$mon2=12;$year2=$year-1;} # Если тек. январь, то предыдущий будет декабрь
$time5="$year2-$mon2-1"; 
$paga222.=&calendar($time5);
$paga222.= qq~</td><td>~;
$time5=$datebase; # $datebase="2003-10-10 10:00:00" - тек. время
$paga222.=&calendar($time5);
$paga222.= qq~</td></tr></table></center>~;
print F $paga222;
close F;
}


sub str2time2 ($) #точная конвертация
{
 my $str = shift;
 my ($str1,$str2)=split(/ /,$str);
 my ($zyear,$zmonth,$zday)=split(/-/,$str1);
 my ($zhour,$zmin,$zsec)=split(/:/,$str2);
 $zyear-=1900;
 $zmonth--;
 my $timeta=timelocal($zsec,$zmin,$zhour,$zday,$zmonth,$zyear);
 return($timeta);
}


sub calendar ($) #Строит выпуски на месяц
{ 
my $paga=''; 
my $timee=shift; my @cal=();
$timee=str2time2($timee);
my ($tsec,$tmin,$thour,$tmday,$tmon,$tyear,$twday) = localtime($timee);
$tyear+=1900; 
$tmon++; 
my $k=0; 
 if ($tsec < 10) {$tsec = "0$tsec";}
 if ($tmin < 10) {$tmin = "0$tmin";}
 if ($thour < 10) {$thour = "0$thour";}
 if ($tmon < 10) {$tmon = "0$tmon";}
 if ($tmday < 10) {$tmday = "0$tmday";}
my $tdate="$tyear-$tmon-1"; #Первое число этого месяца
my $tdate5=str2time2($tdate);
my $tdayxx=(localtime($tdate5))[6];
my $tmon2=0;
my $tyear2=0;

if ($tmon<12)
{$tmon2=$tmon+1;$tyear2=$tyear;}
else
{$tmon2=1;$tyear2=$tyear+1;}

my $tdate6="$tyear2-$tmon2-1 12:00:00"; #Первое число следующего месяца
my $tdate7=str2time2($tdate6)-86400; #Посл.число этого месяца
my $tdayyy=(localtime($tdate7))[6];
my $talldays=int(($tdate7-$tdate5)/86400)+1;
#for (my $i=0;$i<$talldays;$i++)
#{
#$ddd[$i]=$i+1;
#}
my $tdayxx2=0;
if ($tdayxx==0){$tdayxx2=7} else {$tdayxx2=$tdayxx}

for (my $i=$tdayxx2;$i<40;$i++)
{
if ($k<$talldays){
$k++;
my $k33=$k; my $newszx='';
if ($k33<10){$k33="0$k33";}
my $flag22=2;
my $ln;
# сканируем таблицу только для прошедших дней
if (($tyear==$year)&&($tmon==$mon)&&($k33<=$mday))
{
my $result = $dbh->prepare("SELECT count(*) as co FROM table1 
where (post_date like '$tyear-$tmon-$k33\%')");
$result->execute();
$ln = $result->fetchrow_hashref(); 
$result->finish();
}elsif
(($tyear<=$year)&&($tmon<$mon))
{
my $result = $dbh->prepare("SELECT count(*) as co FROM table1 
where (post_date like '$tyear-$tmon-$k33\%')");
$result->execute();
$ln = $result->fetchrow_hashref(); 
$result->finish();
}
else{$ln->{co}=0}

if ($ln->{co}>0){
$newszx=$ln->{co};
$flag22=4;
}else{$flag22=2}
 

# Если есть программы за данное число, даем на них ссылку
if ($flag22==2){$cal[$i]=$k;}
else
{$cal[$i]=qq~<a title=$newszx
href=http://soft.protoplex.ru/?search=$tyear-$tmon-$k33>$k</a>~;}
if ("$tyear-$tmon-$k33" eq "$year-$mon-$mday")
{$cal[$i]=qq~<b>$cal[$i]</b>~;}

}
} my $colll=''; 
# выбираем цвет, исходя из времени года
if ($tmon==12){$colll=qq~#cceeff~;}
if (($tmon>=1)&&($tmon<3)){$colll=qq~#cceeff~;}
if (($tmon>=3)&&($tmon<6)){$colll=qq~#ccffdd~;}
if (($tmon>=6)&&($tmon<9)){$colll=qq~#ffdddd~;}
if (($tmon>=9)&&($tmon<12)){$colll=qq~#ffeeaa~;}

$paga.= qq~
<table bgcolor="$colll" cellpadding=2 cellspacing=1>
<tr align=center>
<td colspan=7 style="text-transform:uppercase;" 
id=ts22><b>$months[$tmon]</b></td>
</tr> ~;
my $rt3=0;
for (my $rt=1;$rt<8;$rt++)
{ my $rt2=my $tcolor=0;
if ($rt==7){$rt2=0;$tcolor="red"}
elsif($rt==6)
{$rt2=6;$tcolor="orange"}
else
{$rt2=$rt;$tcolor="navy"}
$rt3++;
my $width_1='';
if ($rt==1){$width_1=" width=15"}else{$width_1=""}
$paga.= qq~
<tr id=ts31 bgcolor=white align=center>
<td id=ts31$width_1 style="color: $tcolor">$days[$rt2]</td>
<td id=ts31$width_1>$cal[$rt3]</td>
<td id=ts31$width_1>$cal[$rt3+7]</td>
<td id=ts31$width_1>$cal[$rt3+14]</td>
<td id=ts31$width_1>$cal[$rt3+21]</td>
<td id=ts31$width_1>$cal[$rt3+28]</td>
<td id=ts31$width_1>$cal[$rt3+35]</td>
</tr> 
~;
}
$paga.= qq~
</table>~; 

return $paga;
}

Такой алгоритм работает по всему нашему порталу. Если кто-то воспользуется моим методом, проставляйтесь. Либо ставьте ссылку на ПротоПлекс, либо бутылку автору :)