Легенда:
 новое сообщение
 закрытая нитка
 новое сообщение
 в закрытой нитке
 старое сообщение
|
- Напоминаю, что масса вопросов по функционированию форума снимается после прочтения его описания.
- Новичкам также крайне полезно ознакомиться с данным документом.
|
[Perl] хэш->хэш->.....->скаляры 26.05.01 01:02 Число просмотров: 1102
Автор: + <Mikhail> Статус: Elderman
|
Oracle, MSSQL server, DB2 . . .
Vse uzhe resheno
P.S. Access vkonce koncov
|
|
<programming>
|
[Perl] хэш->хэш->.....->скаляры 26.05.01 00:08
Автор: free Статус: Незарегистрированный пользователь
|
Столкнулся с задачей, и решил ее так - создал массив ссылок на хэши, в хэшах ссылки на структуры, элементами которых являются скаляры и ссылки на другие структуры (цель была правильно обрабатывать и выводить таблицы из базы данных (причем каждая из таблиц имеет еще 2 вложенных таблицы)). И рекуррсивно бегаю по полученному объекту.
- работает, но получилось не красиво.....отстой :)
А как бы правильно такие проблемы решать (загрузка/обработка таблиц, в которые на несколько уровней вложена куча табличек помельче (причем хранить мелкие таблички отдельно нельзя :-( ?
|
|
[Perl] хэш->хэш->.....->скаляры 17.07.01 23:56
Автор: Андрей (APL) Статус: Незарегистрированный пользователь
|
> Столкнулся с задачей, и решил ее так - создал массив ссылок
> на хэши, в хэшах ссылки на структуры, элементами которых
> являются скаляры и ссылки на другие структуры (цель была
> правильно обрабатывать и выводить таблицы из базы данных
> (причем каждая из таблиц имеет еще 2 вложенных таблицы)). И
> рекуррсивно бегаю по полученному объекту.
>
> - работает, но получилось не красиво.....отстой :)
>
> А как бы правильно такие проблемы решать
> (загрузка/обработка таблиц, в которые на несколько уровней
> вложена куча табличек помельче (причем хранить мелкие
> таблички отдельно нельзя :-( ?
КОД НЕ ОПТИМИЗИРОВАН (на днях написал)
внизу пример smml файла (количество вложений не ограничено
--------------------------------
undef %smml;
#грузим файл
%smml = load_smml_file('zzz.smml');
$smml{'filename'} = 'zzz_out.smml';
save_smml_file(%smml);
# доступ к записям: $hash{<type>}{<field name>}{<type>}{<field name>}{<type>}{<field name>}...{<type>}{<field name>}
sub _save_smml_2 {
my ($hsmml, $name, $level, $oldname, $tabs) = @_;
my $_k;
my %hash = %{$$hsmml};
my @t = keys %hash;
if($level > 1) {
if($#t == -1) {
if($oldname eq 'STRING') {
print_tabs($tabs);
print SMML_FILE "<STRING NAME=\"$name\" VALUE=\"$$hsmml\"\/>\n";
} elsif($oldname eq 'REAL') {
print_tabs($tabs);
print SMML_FILE "<REAL NAME=\"$name\" VALUE=\"$$hsmml\"\/>\n";
} elsif($oldname eq 'INTEGER') {
print_tabs($tabs);
print SMML_FILE "<INTEGER NAME=\"$name\" VALUE=\"$$hsmml\"\/>\n";
} elsif($oldname eq 'BOOL') {
print_tabs($tabs);
print SMML_FILE "<BOOL NAME=\"$name\" VALUE=\"$$hsmml\"\/>\n";
} elsif($oldname eq 'DATE') {
print_tabs($tabs);
print SMML_FILE "<DATE NAME=\"$name\" VALUE=\"$$hsmml\"\/>\n";
}
} else {
if($oldname eq 'ARRAY') {
print_tabs($tabs);
print SMML_FILE "<ARRAY NAME=\"$name\">\n\n";
$tabs++;
} elsif($oldname eq 'RECORD') {
print_tabs($tabs);
print SMML_FILE "<RECORD NAME=\"$name\">\n";
$tabs++;
}
}
}
foreach (keys %hash) {
_save_smml_2(\$hash{$_}, $_, $level+1, $name, $tabs);
}
if($level > 1) {
if($#t == -1) {
} else {
if($oldname eq 'ARRAY') {
$tabs--;
print_tabs($tabs);
print SMML_FILE "<\/ARRAY>\n\n";
} elsif($oldname eq 'RECORD') {
$tabs--;
print_tabs($tabs);
print SMML_FILE "<\/RECORD>\n\n";
}
}
}
}
sub save_smml_file {
my %_data = @_;
open (SMML_FILE, ">$_data{'filename'}")|return -1;
flock(SMML_FILE, LOCK_EX);
my $key;
print SMML_FILE "<?XML version=\"1.0\"?>\n<!DOCTYPE smml \/>\n<SMML VERSION=\"1.0\" COMPAT_VERSION=\"1.0\">\n\n";
foreach (keys %_data) {
_save_smml_2(\$_data{$_}, $_, 1, $_, 0);
}
print SMML_FILE "\n\n<\/SMML>";
close (SMML_FILE);
}
sub print_tabs {
my ($tabs) = @_[0];
do {
print SMML_FILE " ";
$tabs--;
} while ($tabs>0);
}
sub load_smml_file {
my ($_fn) = @_;
my ($str, %data, @t, %flag, @path, $line);
$line = 0;
undef @path;
open (SMML_FILE, "$_fn")|return -1;
undef %data;
$data{'filename'} = $_fn;
foreach $str (<SMML_FILE>) {
$str =~ s/(\t)/ /ge;
do {
$again = 0;
# обработка тэга <SMML>
if( $flag{'<SMML>'} == 0 ) {
if($str =~ /()<SMML(.*)>(./) {
$flag{'<SMML>'} = 1;
$str = $3;
$again = 1;
}
}
if($flag{'<SMML>'}==1) {
# внутри тэгов <SMML></SMML>
if($str =~ /()<(.*)\/>(./) {
# простой элемент
$again = 1;
$str = $3;
$flag{'DO'} = 1;
my $param = $2;
if($param =~ /STRING (.*)/) {
push @path, 'STRING';
$param = $1;
} elsif($param =~ /INTEGER (.*)/) {
push @path, 'INTEGER';
$param = $1;
} elsif($param =~ /REAL (.*)/) {
$param = $1;
push @path, 'REAL';
} elsif($param =~ /BOOL (.*)/) {
$param = $1;
push @path, 'BOOL';
} elsif($param =~ /DATE (.*)/) {
push @path, 'DATE';
$param = $1;
} else {
push @path, '<undef>';
$flag{'DO'} = 0;
}
$param =~s/( ){2,}/' '/ge;
$param =~s/ \Z//ge;
$param =~ s/ =/'='/ge;
$param =~ s/= /'='/ge;
if ($param =~ /NAME=\"(.*)\" (.*)/|$param =~ /NAME=(.*) (.*)/) {
$val = $1;
push @path, "$val";
$flag{'NAME'} = 1;
} else {
push @path, "<undef>";
}
if($flag{'DO'} == 1) {
my $value = "";
if ($param =~ /VALUE=\"(.*)\"/|$param =~ /VALUE=(.*)/) {
$value = $1;
}
if($flag{'NAME'}==1 && length $value) {
my $code = "";
foreach(@path) {
$code = "$code"."{'$_'}";
}
$code = '$data'."$code";
eval ' chomp $a;';
if(length $code) { eval("$code = '$value';"); }
}
pop @path;
pop @path;
$flag{'NAME'} = 0;
}
} else {
# составной элемент
if($str =~ /<RECORD()NAME=\"(.*)\"(./|$str =~ /<RECORD()NAME=(.>/) {
$str = $3;
push @path, 'RECORD';
push @path, $2;
}
if($str =~ /<\/RECORD>(.*)/) {
$str = $1;
pop @path;
pop @path;
}
if($str =~ /<ARRAY()NAME=\"(.*)\"(./|$str =~ /<ARRAY()NAME=(.>/) {
$str = $3;
push @path, 'ARRAY';
push @path, $2;
}
if($str =~ /<\/ARRAY>(.*)/) {
$str = $1;
pop @path;
pop @path;
}
}
}
# обработка тэга </SMML>
if($str =~ /()<\/SMML>(./ && $flag{'<SMML>'}==1) {
$flag{'<SMML>'} = 0;
close(TEMP);
return %data;
}
} while($again);
$line++;
}
close(SMML_FILE);
return %data;
}
sub _eval {
eval @_;
}
sub get_hash_keys {
my $_h = @_[0];
my @_res;
undef @_res;
foreach (keys (%{$$_h}) ) {
push @_res, $_;
}
return @_res;
}
------- пример smml файла -----
<SMML VERSION="1.0" COMPAT_VERSION="1.0">
<RECORD NAME=main>
<STRING NAME=rec1 VALUE="some text"/>
<BOOL NAME=be_or_not_to_be VALUE=true/>
<RECORD NAME=sub_record>
<DATE NAME=год VALUE="1999"/>
<INTEGER NAME=квартал VALUE="3"/>
</RECORD>
</RECORD>
</SMML>
|
|
[Perl] хэш->хэш->.....->скаляры 26.05.01 01:02
Автор: + <Mikhail> Статус: Elderman
|
Oracle, MSSQL server, DB2 . . .
Vse uzhe resheno
P.S. Access vkonce koncov
|
|
|
подробно о проекте
Анализ криптографических сетевых... 
