ZXNet эхоконференция «zxnet.pc»

Hемедленно нажми на RESET, Valerij!

14 Oct 01 03:35, Valerij Kozhevnikoff wrote to All:

VK> Есть ли более новый и безглючный сабж?

Выкинь и забудь.

VK> PS: а как хорошо было когда-то. Lara Croft -- и никаких проблем.

Hу могу дать перловый скрипт. Только там с DBM'ами какие-то проблемы былы,
а я их как-то криво пофиксил -- новые каталоги, создаваемые для разююканных
файлов,
должны называться по имени эхи, а получается цифрами. А раньше правильно
работало,
но при упгрейде Mandrake7.0 -> Slackware8.0 с DBM трабл возник. А я в перле
можно
сказать ничего не понимаю -- в одном месте пофиксил, в другом поломал... :-(


=== Cut ===
#!/usr/bin/perl -w

# ЭТО ТО МЕСТО ГДЕ ИЩЕТСЯ КОHФИГ
> ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
$config='/etc/fido/uudecode.conf';
> ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
> У тебя типа 'c:fidoconfigsuudecode.conf'


### Pogramm ################################################### Don't touch ###
use Fcntl;
use GDBM_File;
##DB_File;
> ^^^^^^^^^^^^^
> вот раньше было DB_File, a в новой версии его вообще нет.
> пришлось на GDBM переходить (и open/close дальше другой).


$ver="UUE Decoder v0.41 (c) Sln !";


# parse config #
open(CFG, "< $config") || die "$config: $!
";

(%spoolpkt,%maskpkt,%file,%set,%echo)=();
$i=0;

while(){

$spooldec=$1 if /^decodeds+(S+)/i;
$spoolpkt{$i}=$1 if /^pkts+(S+)/i;
$maskpkt{$i}=$1 if /^maskpkts+(S+)/i;

$file{log}=$1 if /^logs+(S+)/i;
$file{res}=$1 if /^resources+(S+)/i;
$file{rec}=$1 if /^recodes+(S+)/i;
$file{dup}=$1 if /^dupes+(S+)/i;
$file{sts}=[$1,$2] if /^stats+(S+)s+([abc]{1,3})/i;
$file{bbs}=$1 if /^filesbbss+(S+)/i;

$set{dos}=$1 if /^rendoss+(d)/i;
$set{cmp}=$1 if /^rencomps+(d)/i;
$set{code}=$1 if /^rencodes+(d)/i;
$set{dupe}=$1 if /^dupenames+(d)/i;
$set{del}=$1 if /^delpkts+(d)/i;
$set{keep}=$1 if /^keepuues+(d)/i;
$set{rec}=$1 if /^recbbss+(d)/i;
$set{bad}=$1 if /^savebads+(d)/i;
$set{form}=$1 if /^formbbss+(.+)/i;
$set{more}=$1 if /^delmores+(d)/i;

$echo{$i}=[$1,$2] if /^echos+(S+)s+(S+)/i;


$i++;
}
close CFG;



die "Check spool for decoded files (not def)
" unless defined $spooldec;
die "Check spool for incoming pkts (not def)
" unless %spoolpkt;
die "Check mask for incoming pkts
" unless %maskpkt;
die "Check set any param from config
" if keys %set !=10;
die "Echo mask not defined
" unless %echo;

uplog("Starting $ver");





if(exists $file{rec}){
uplog("Loading recode file");
open(CODE, "< $file{rec}") || errlog("$file{rec}: $!");
$in=$out=';
while(){ $in.="\$1",$out.="\$2" if /^0+(x[da-f]+)s+0+(x[da-f]+)/i
}
close(CODE);
}





undef %uue;

# load resorce file
if(exists $file{res}){
uplog("Loading resource file");
tie %res, 'GDBM_File