DiBR
обычная кошмарная
домашняя страничка
Ежекакполучится околокомпьютерное обозрение
 
  <<<  предыдущий Tech! archive #166 следующий  >>>  
   Последний выпуск       Архив       Ссылки       Полезности       humor.filtered       Фотки       О сайте   
          Это - достаточно беспорядочный архив сообщений конференций сети fidonet, которые на момент их прочтения мной показались полезными или интересными. Многие устарели, многие узкоспецифичны и малоинтересны, но может оказаться и что-то новое...
         
- __techs (2:5015/42) ----------------------------------------------- __techs -
Msg  : 166 of 1000                         Rcv
From : Kostya Rodjushkin                   2:5015/48.2     17 Nov 96  00:56:58
To   : Dmitry Radishev                                     17 Nov 96  01:43:56
Subj : Hi Dmitry
-------------------------------------------------------------------------------
@AREA:NETMAIL
Привет Dmitry!

Hа смотри и дрожи от  ужаса. ;)
Там еще два батчика прилагаются. этот обрабатывает только один тик.
________


($#ARGV == 0) || die "for use requared one parametrs";
$ticname=$ARGV[0];

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
print "$mday.$mon $hour:$min:$sec $ticname - ";

#Енто вместо конфигов. ;)
$newsname="\\\\fido\\\\echos\\\\new.lst";
$echodirname="\\\\fido\\\\echos\\\\";
$badticdirname="\\\\fido\\\\echos\\\\";
$incomingdirname="\\\\fido\\\\file\\\\";

# Cчитываем тик файл
while($_=<>){
 @h=split(/ /,$_,2);
 $l{"\\U$h[0]\\E"}=join('',$l{"\\U$h[0]\\E"},$h[1]);
}

#Обрезаем переводы строк на концах
chop $l{'FILE'};
chop $l{'DESC'};
chop $l{'LDESC'};
chop $l{'AREA'};
chop $l{'ORIGIN'};

# Если в тике не присутствуют  File или Area то тик плохой.
if(($l{'FILE'} eq "")||($l{'AREA'} eq "")){
 $err="Not find File or Area";
 goto badtic;
}

# Создадим имя каталога для Area,а также некоторые другие имена.
$dn=$echodirname.substr(join("", split(/\\./,$l{'AREA'}) ),0,8);
$newname=$dn.'\\\\'.$l{'FILE'};
$oldname=$incomingdirname.$l{'FILE'};
$filesbbsname=$dn.'\\\\files.bbs';

#Создадим каталог для эхи.
system "if not exist $dn\\\\*.* md $dn";

if(rename($oldname,$newname)==0) {
 $err="Can't move file $l{'FILE'}";
 goto badtic;
}

# Добавим новость
if(!open(an,">>$newsname")){$err="Can't open $newsname"; goto othererror;}
print an "-------- $l{'AREA'} -------\\n";
print an "File   = $l{'FILE'}\\n";
print an "Origin = $l{'ORIGIN'}\\n";
if ($l{'DESC'} ne "") { print an "$l{'DESC'}\\n";}
if ($l{'LDESC'} ne "") { print an "\\t$l{'LDESC'}\\n";}
close an;

# Добавим строчку в files.bbs
open(an,">>$filesbbsname") || die "can't open";
print an "$l{'FILE'}\\t$l{'DESC'}\\n";
if ($l{'LDESC'} ne "") {
 @ld=split(/\\n/,$l{'LDESC'});
 for($i=0;$i<$#ld;++$i){
   print an "\\t\\t$ld[$i]\\n";
 }
}

close an;
unlink($ticname);

goodtiic:
print "$l{'FILE'} $l{'AREA'} $l{'ORIGIN'}\\n";
exit(0);

badtic:
 print "$err\\n";
 # Добавим новость
 open(an,">>$newsname");
 print an "ERROR!!!!! $ticname   $err\\n";
 close an;
 rename($ticname,$badticdirname.$ticname);
 exit(1);

othererror:
 print "$err\\n";
 # Добавим новость
 open(an,">>$newsname");
 print an "ERROR!!!!! $ticname   $err\\n";
 close an;
 exit(1);
----------



Kostya

--- г.Дед 2.50.B1016+
* Origin: RKV (FidoNet 2:5015/48.2)






<<<

архив dibr

>>>'