Mail with attachement

Приведенная программа позволяет отправить открытку с веб странички. Подпрограмма &vibor() читает директорию с картинками в формате jpg (можно и в других форматах). Далее перед формой происходит вывод самих картинок, которые находятся в определенной директории. Около каждой картинки ставится чекбокс, отмечая который выбирается нравящаяся картинка. Так-же предусмотрена проверка на заполнение всех полей в форме. Есть один минус, такая программа полностью открывает relay, но в принципе все аналогичные программы так и работают. Если сделать постраничный вывод картинок из директории, то можно отправлять картинки из галереи, содержащей 1000 фотографий или рисунков. #!/usr/bin/perl -w print "content-type:text/html\n\n"; use lib '/usr/local/etc/httpd/cgi-bin/photo/MIME-Lite-2.117/lib'; use Mime::Lite; use CGI 'param'; $dir="/usr/local/etc/httpd/htdocs/otkritki"; $url="http://www.server.ru/otkritki"; $emls = param('emls'); $cont = param('cont'); $email = param('email'); $name = param('name'); $subject = param('subject'); $body = param('body'); $img = param('img'); $pic=$dir."/".$img; open F, "<begin"; @mass1=<F>; close F; open F, "<end"; @mass2=<F>; close F; print @mass1; if($cont eq 'mail'){ if($email ne '' && $img ne '' && $emls ne '' && $name ne '' && $subject ne '' && $body ne ''){ &sent(); } unless($email ne '' && $img ne '' && $emls ne '' && $name ne '' && $subject ne '' && $body ne ''){ print qq~<p><center><b>Не заполнено одно из полей формы, либо не выбрана картинка!!</b></center>~; &form() } } else{&form()} sub sent{ $msg = MIME::Lite->new( From =>qq{"$name" <$email>}, To =>$emls, Subject =>$subject, Type =>'multipart/mixed' ); $msg->attach(Type =>'text', Data => qq{$body} ); $msg->attach(Type =>'image/jpeg', Path =>$pic, Filename=>'new_year.jpg', ); $msg->attach(Type =>'text', Data => qq{ Vasha otkritka! } ); $msg->send; print qq{<center><b>Ваше сообщение отправлено!</b></center>}; &form(); } sub form{ print "<form action=http://www.server.ru/cgi/photo/letter.pl method=post>\n"; &vibor(); print "<a name=up></a>"; print qq~<center><b>Выберите фотографию из списка и отправьте <a href=#post>открытку</a></b></center> <table CELLSPACING=10 CELLPADDING=10>\n~; foreach $file(@files){ $i++; my $big=$file; $big=~s!mini_!!g; print qq~<td><a href=$url/$big target=_new><img src=$url/$file border=0></a></td><td valign=bottom><input type=radio name=img value=$big></td></tr>\n~ if $i%2 == 0; print qq~<tr><td><a href=$url/$big target=_new><img src=$url/$file border=0></a></td><td valign=bottom><input type=radio name=img value=$big ></td>\n~ if $i%2 != 0; } print qq~</table><a name=post></a><b><center><a href=#up>наверх</a></center></b><br> <BR><b>Введите адрес получателя:</b><br> <input type=text name=emls size=46 value=$emls><BR> <b>Введите Ваш адрес:</b> <br> <input type=text name=email size=46 value=$email><br> <B>Ваше имя: </B><BR> <input type=text name=name size=46 value=$name><br> <B>Заголовок письма:</B><BR> <input type=text name=subject size=46 value=$subject><br> <B>Текст письма:</B><BR> <textarea name=body rows=8 cols=50>$body</textarea><br> <input type=submit value="Отправить!">       <input type=hidden name=cont value=mail> <input type=reset value="очистить."> </form> ~; } sub vibor{ opendir(DIR,$dir) or (warn "Cannot open $dir: $!" and next); rewinddir(DIR); @files=grep {!(/^\./) && /mini_/io && -f "$dir/$_"} readdir(DIR); closedir (DIR); return @files; } print @mass2; Пример работы этого скрипта смотрите здесь.

В данном случае почтовая программа типа Netscape или www.mail.ru при прочтении письма делает файл видимым, т.е. картинка видна сразу. Прочитав документацию на content-type для определенного типа файла, можно ту-же саму картинку выгружать, скажем в photoshop. Поискав в www.google.com название контент-тайпа, скажем, файла в формате excel, можно по одному нажатию на файл запускать соответствующее расширению файла приложение. Приведенная ниже подпрограмма высылает данные из базы пользователю в формтае excel так, что при нажатии на приаттаченный файл, помимо картинки, запускается microsoft excel: do{ my $msg = MIME::Lite->new( From =>qq{"Young scientist"}, To =>$email, Subject =>qq{"Ваши данные"}, Type =>'multipart/mixed' ); $msg->attach(Type =>'text', Data => qq{"$data"} ); $msg->attach(Type => 'image/jpeg', Path => '/usr/local/photo/head.jpg', Filename =>'head.jpg' ); $msg->attach(Type => 'application/x-msexcel', Path => "$dir/users/$login/mydata.xls", Filename =>'mydata.xls' ); $msg->send; print qq{<center><b>На Ваш адрес отправлено сообщение с Вашими данными!</b></center>}; } if grep{/^$login\t(.*)\t(.*?)\n/} @tmp; С тем же успехом можно написать вместо application/x-msexcel application/x-msword, если необходимо отправлять пользователю файл *.doc или *.rtf