1;

#Процедуры для работы с пунктом меню "Рассылка" 

#Формат файла settings.db
#1-я строка - все настройки, разделенные \x01
#2-я строка - текст письма-подтверждения подписки 
#  (в форматах txt/html, тексты разделены \x01, перевод строки заменен на \x02 
#3-я строка - текст письма, посылаемого после отказа от подписки 
#  (в форматах txt/html, тексты разделены \x01, перевод строки заменен на \x02
#4-я строка - html-код формы для подписки/отписки
#5-я строка - html-код страницы для выдачи клиенту результатов подписки
 


#Чтение настроек (читаем только 1 строку, больше здесь нет надобности)
sub read_settings {
open CONF, "<$setupfile"; my $line=<CONF>; close(CONF); chomp($line); $line=~ s/\r//;
($adminname, $adminmail, $MAIL_PROGRAM, $confirmsubs, $confirmunsubs, $abookname, $cntzap, $defcharset, $defmode) = split (/\x01/, $line);
}


# Рассылка ( $in{'txt'} и $in{'html'} - тексты писем 
sub send_letters {
if (!$in{'subject'}) {&put_message('НЕ введена тема сообщения!'); return;}
if (!$in{'txt'}) {&put_message('НЕ введен текст письма в формате TXT'); return;}
&read_settings; my $allcnt=0;


open (ABOOK, $abookname); while (<ABOOK>) {$allcnt++;}
if ($allcnt==0) {close(ABOOK); &put_message('В адресной книге нет ни одного подписчика!'); return;}
seek (ABOOK,0,0);
#делаем 6 буферов для отправки. Съест достаточно много памяти, но отправка будет работать быстрее

$msg{'win_txt'}=$in{'txt'};  

# --------12.07.2000-------------------------
# Проверяем, есть ли аттачменты
my $attflg=0; my $i=1; my $maxfiles=10;
while ($i<$maxfiles+1) { if ($in{"srcfile$i"}) {$attflg=1; $in{"srcfile$i"}=pvd_base64_encode($in{"srcfile$i"})} 
                        $i++;
                        }

$subj{'win'}=$in{'subject'};
#Если есть аттачменты - поля Subject и From переделываем в base64
# -------------------------------------------
#формируется по принципу:
#   Koi:   =?koi8-r?B?(тема_в_base64)?=
#   win:   =?windows-1251?B?(тема_в_base64)?=
#   iso:   =?iso-8859-5?B?(тема_в_base64)?=

if ($attflg==1) {

$subj{'win'}="=?windows-1251?B?".&pvd_base64_encode($in{'subject'})."?=";
$subj{'koi'}="=?koi8-r?B?".&pvd_base64_encode(wintokoi($in{'subject'}))."?=";
$subj{'iso'}="=?iso-8859-5?B?".&pvd_base64_encode(wintoiso($in{'subject'}))."?=";
$from{'win'}="=?windows-1251?B?".&pvd_base64_encode($adminname)."?= <$adminmail>";
$from{'koi'}="=?koi8-r?B?".&pvd_base64_encode(wintokoi($adminname))."?= <$adminmail>";
$from{'iso'}="=?iso-8859-5?B?".&pvd_base64_encode(wintoiso($adminname))."?= <$adminmail>";
}
else {
$subj{'koi'}=wintokoi($subj{'win'}); 
$subj{'iso'}=wintoiso($subj{'win'});
$from{'win'}="\"$adminname\" <$adminmail>";
$from{'koi'}=wintokoi($from{'win'}); 
$from{'iso'}=wintoiso($from{'win'});      
}

#Если формат html не введен - делаем копию из txt, подсвечиваем ссылки
if (!$in{'html'}) 
  {$msg{'win_html'}=chehttp("<HTML><HEAD><TITLE></TITLE></HEAD><BODY><PRE>\n$in{'txt'}\n</PRE></body></html>");
   $msg{'win_html'}=chemail($msg{'win_html'});
  }
 else {$in{'html'}=~ s/<meta([\w, \s, \", \=, \n]+)\>//ig; $msg{'win_html'}=$in{'html'}   }
$in{'txt'}=""; $in{'html'}="";
$msg{'koi_txt'}=wintokoi($msg{'win_txt'}); $msg{'koi_html'}=wintokoi($msg{'win_html'});
$msg{'iso_txt'}=wintoiso($msg{'win_txt'}); $msg{'iso_html'}=wintoiso($msg{'win_html'}); 
$chset{'win'}='windows-1251'; $chset{'koi'}='koi8-r'; $chset{'iso'}='iso-8859-5';
$chset{'txt'}='text/plain'; $chset{'html'}='text/html';



#Собственно рассылка
my $sentok=0; my $senterr=0; 
my $boundary="--Boundary_$$.pvdlab.net";
open (LOG,">logsent.txt");
print LOG "-----------Начало отправки ----------\n";
while (<ABOOK>) {
 chomp; s/\r+$//;
 next if !$_;
 ($email, $charset, $mode)=split(/\x01/, $_, 3);
 $charset=$defcharset if (!$charset);
 $mode=$defmode if (!$mode);

 $flg=0;
 open (MZ,$MAIL_PROGRAM) or $flg=1;
 if ($flg==0) 
  {  print MZ "To: $email\n";
     print MZ "From: $from{$charset}\n";
     print MZ "Subject: $subj{$charset}\n";
     print MZ "MIME-Version: 1.0\n";
if ($attflg==1) {
 print MZ "Content-Type: multipart/mixed; boundary=\"$boundary\"\n";
 print MZ "\n";
 print MZ "This is a multi-part message in MIME format.\n";
 print MZ "\n";
 
 #текст письма
 print MZ "--$boundary\n";

     print MZ "Content-Type: $chset{$mode}\; charset=\"$chset{$charset}\"\n";
     print MZ "Content-Transfer-Encoding: 8bit\n\n";
     print MZ $msg{"$charset\_$mode"};
     print MZ "\n\n";

     my $i=1; my $maxfiles=10;
    while ($i<$maxfiles+1) { 
          if ($in{"srcfile$i"}) {

#Аттачмент 
 print MZ "--$boundary\n";
 print MZ "Content-Type: ", $in{"ctfile$i"}, "; name=\"", $in{"file$i"}, "\"\n";
 print MZ "Content-Transfer-Encoding: Base64\n";
 print MZ "Content-Disposition: attachment; filename=\"", $in{"file$i"}, "\"\n";
 print MZ "\n";
 print MZ $in{"srcfile$i"};
 print MZ "\n\n";

          } 
       $i++;
     }


 #конец письма
 print MZ "--$boundary--\n";

   }
    else {
     print MZ "Content-Type: $chset{$mode}\; charset=\"$chset{$charset}\"\n";
     print MZ "Content-Transfer-Encoding: 8bit\n\n";
     print MZ $msg{"$charset\_$mode"};
	 print MZ "\n\n";
         }
	 close (MZ); $sentok++;
	 print LOG "$email - Ok\n";
  }	 else {$senterr++; print LOG "---- Ошибка отправки $email \n";}
 
}
close(ABOOK); 
print LOG "-----------Конец отправки ----------\n"; 
print LOG "Всего подписчиков: $allcnt\n";
print LOG "Отправлено писем: $sentok\n";
print LOG "Не отправлено: $senterr\n";
close(LOG);
&put_message("Всего подписчиков: $allcnt<br>Отправлено писем: $sentok<br>Не отправлено: $senterr");
}

# Вывод на экран форм для ввода письма
sub input_letters {
my $lettertype=shift;
my $numbtn=$sendletter; 

print qq(
<table width="600" border="0" cellspacing="0" cellpadding="0" bgcolor=black ><tr><td>
<table width="600" border="0" cellspacing="1" cellpadding="1">
<tr><th bgcolor=#FEF0CD align=center><font size="-1" face="Verdana, Arial"><b>Введите тему и тексты писем, затем нажмите 
кнопку ОТПРАВИТЬ</b>
<br><font size=-2>Поля "Тема" и "Формат ТЕКСТ" обязательны для заполнения<br>
Если не заполнять поле "HTML", его значение будет сформировано на основе поля ТЕКСТ</font>
</font></th></tr>
<tr><td bgcolor=#F9F1D7 align=left><font size="-1" face="Verdana, Arial">Тема сообщения: <input name="subject" $inputstyle></td></tr>
<tr><td bgcolor=#F9F1D7 align=left><font size="-1" face="Verdana, Arial">Формат "ТЕКСТ"</font></td></tr>
<tr><td bgcolor=#FFFFFF align=left>
<textarea rows=8 cols=71 wrap=off name="txt" class=ta>$txt</textarea>
</td></tr>

<tr><td bgcolor=#F9F1D7 align=left><font size="-1" face="Verdana, Arial">Формат "HTML"</font></td></tr>
<tr><td bgcolor=#FFFFFF align=left>
<textarea rows=8 cols=71 wrap=off name="html" class=ta>$html</textarea>
</td></tr>

<tr><td bgcolor=#F9F1D7 align=left><font size="-1" face="Verdana, Arial">Присоединить файлы</font></td></tr>
<tr><td bgcolor=#F9F1D7 align=left>
<input type=file name=file1 $inputstyle><br>
<input type=file name=file2 $inputstyle><br>
<input type=file name=file3 $inputstyle>
</td></tr>

<tr><td  bgcolor=#F9F1D7 align=right>
<INPUT TYPE="button" VALUE="ОТПРАВИТЬ >>" onClick="presubmit($numbtn)" $buttonstyle>
</td>

</table></td></tr></table>
);
}


# возращает перекодированную переменную, вызов wintokoi(<переменная>)
sub wintokoi {
    my $tmp=shift;
    $tmp=~ tr/\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA\xFB\xFC\xFD\xFE\xFF/\xE1\xE2\xF7\xE7\xE4\xE5\xF6\xFA\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF2\xF3\xF4\xF5\xE6\xE8\xE3\xFE\xFB\xFD\xFF\xF9\xF8\xFC\xE0\xF1\xC1\xC2\xD7\xC7\xC4\xC5\xD6\xDA\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD2\xD3\xD4\xD5\xC6\xC8\xC3\xDE\xDB\xDD\xDF\xD9\xD8\xDC\xC0\xD1/;
return $tmp;
}

# возращает перекодированную переменную, вызов wintoiso(<переменная>)
sub wintoiso {
  my $tmp=shift;
    $tmp=~ tr/\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA\xFB\xFC\xFD\xFE\xFF/\xB0\xB1\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xBB\xBC\xBD\xBE\xBF\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF/;
return $tmp;
}

# если в строке есть урл то возвращает html гиперссылку на него  &lt&gt
sub chehttp {
 @_[0]=~ s/(http:\/\/[\w,\.,\-,\&,\/,\~]+)/\<a href=\"$1\"\>$1\<\/a\>/ig;
return @_[0];
}

# если в строке есть email то возвращает html гиперссылку на него
sub chemail {
 @_[0]=~ s/([\w,\-,\.]+\@[\w,\-,\.]+\.\w{2,3})/\<a href=\"mailto:$1\"\>$1\<\/a\>/g;
return @_[0];
}


sub pvd_base64_encode ($;$)
{
    my $res = "";
    my $eol = $_[1];
    $eol = "\n" unless defined $eol;
    pos($_[0]) = 0;                          # ensure start at the beginning
    while ($_[0] =~ /(.{1,45})/gs) {
    $res .= substr(pack('u', $1), 1);
    chop($res);
    }
    $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
    # fix padding at the end
    my $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
    # break encoded string into lines of no more than 76 characters each
    if (length $eol) {
    $res =~ s/(.{1,76})/$1$eol/g;
    }
    $res=~ s/\s+$//;
    $res;
}

1;