11 |
use Zot; |
use Zot; |
12 |
|
|
13 |
our $DEFAULT_WIDTH = 16; |
our $DEFAULT_WIDTH = 16; |
14 |
|
our $MAX_WIDTH = 80; |
15 |
|
our $DEFAULT_TEXT_WIDTH = 40; |
16 |
|
|
17 |
sub validate_file |
sub validate_file |
18 |
{ |
{ |
36 |
<cfield name="%s.%s"/> |
<cfield name="%s.%s"/> |
37 |
</eq>'; |
</eq>'; |
38 |
|
|
39 |
|
# $condition .= ($table->has_style('history')) ? "_%s_data" : "%s"; |
40 |
|
|
41 |
my ($rel) = grep $_ eq $parent, $table->rels; |
my ($rel) = grep $_ eq $parent, $table->rels; |
42 |
|
|
43 |
return sprintf( $condition . ($table->has_style('history')) ? "_%s_data" : "%s", |
return sprintf( $condition, |
44 |
$table->name, $rel, $table->rel($rel), $table->name, $rel ); |
$table->name, |
45 |
|
$rel, |
46 |
|
$table->rel($rel), |
47 |
|
sprintf($table->has_style('history') ? "_%s_data" : "%s", |
48 |
|
$table->name), |
49 |
|
$rel ); |
50 |
} |
} |
51 |
|
|
52 |
|
|
70 |
|
|
71 |
sub repeat |
sub repeat |
72 |
{ |
{ |
73 |
my $chunk = shift; |
my $r = shift; |
74 |
my $res = shift; |
my @s = @{ shift @_}; |
75 |
my $zot = shift; |
my $out; |
76 |
my $r = ''; |
foreach my $i (0..$#s) |
|
my $n = 0; |
|
|
my $width = $DEFAULT_WIDTH; |
|
|
# print STDERR Dumper $struct; |
|
|
foreach (grep /^LABEL_/, keys %$res) |
|
77 |
{ |
{ |
78 |
my $b = $chunk; |
$out .= "\@{ \$i=$i }\@\n$r"; |
79 |
|
} |
80 |
$b =~ s/\@\_LABEL\_\_\@/$res->{$_}/; |
return $out; |
81 |
s/^LABEL_/FIELD_/; |
} |
|
$b =~ s/\@\_FIELD\_\_\@/$res->{$_}/; |
|
|
|
|
|
my ($table, $field) = $res->{$_} =~ /^(.*)\.(.*)$/; |
|
|
$table =~ s/^_(.*)_data$/$1/; |
|
|
|
|
|
if ($zot->table($table)->attr($field) =~ /(\d+)/) |
|
|
{ |
|
|
$width = $1 + 1; |
|
|
} |
|
|
|
|
|
$b =~ s/\@\_ENTRY\_\_\@/"${table}_${field}_entry"/eg; |
|
|
|
|
82 |
|
|
83 |
$b =~ s/\@\@(.*?)\@\@/eval $1/ges; |
sub repeat_hash |
84 |
$r .= $b; |
{ |
85 |
$n++; |
my $r = shift; |
86 |
|
my %h = %{ shift @_ }; |
87 |
|
my $out; |
88 |
|
foreach my $field (keys %h) |
89 |
|
{ |
90 |
|
$out .= "\@{ \$field='$field' }\@\n$r"; |
91 |
} |
} |
92 |
|
return $out; |
93 |
|
} |
94 |
|
|
95 |
|
sub expand_vars |
96 |
|
{ |
97 |
|
my $r = shift; |
98 |
|
$r =~ s/\$(\w+)/\$results{$1}/g; |
99 |
return $r; |
return $r; |
100 |
} |
} |
101 |
|
|
108 |
EXPAND => EXPAND_ALL |
EXPAND => EXPAND_ALL |
109 |
}}, |
}}, |
110 |
'database', |
'database', |
|
'sorter', |
|
111 |
'table', |
'table', |
|
'form', |
|
112 |
'zotfile' => { VALIDATE => \&validate_file }, |
'zotfile' => { VALIDATE => \&validate_file }, |
113 |
'skeleton' => { VALIDATE => \&validate_file }, |
'skeleton' => { VALIDATE => \&validate_file }, |
114 |
|
'form', |
115 |
|
'fqdn' => { ARGCOUNT => ARGCOUNT_LIST }, |
116 |
|
'width' => { ARGCOUNT => ARGCOUNT_LIST }, |
117 |
|
'height' => { ARGCOUNT => ARGCOUNT_LIST }, |
118 |
'page' => { ARGCOUNT => ARGCOUNT_HASH }, |
'page' => { ARGCOUNT => ARGCOUNT_HASH }, |
119 |
'box' => { ARGCOUNT => ARGCOUNT_HASH }, |
'order_by', |
120 |
'label' => { ARGCOUNT => ARGCOUNT_HASH } |
'search_by' => { ARGCOUNT => ARGCOUNT_LIST }, |
121 |
|
'search_label' => { ARGCOUNT => ARGCOUNT_LIST }, |
122 |
|
'result_label' => { ARGCOUNT => ARGCOUNT_LIST }, |
123 |
|
'label' => { ARGCOUNT => ARGCOUNT_LIST }, |
124 |
|
'field' => { ARGCOUNT => ARGCOUNT_LIST } |
125 |
); |
); |
126 |
|
|
127 |
$config->file($ARGV[0]); |
$config->file(pop @ARGV); |
128 |
|
$config->args(); |
129 |
|
|
130 |
my ($zot, $skel, @tables, @histables, @conditions); |
my ($zot, $skel, @tables, @histables, @conditions); |
131 |
|
|
133 |
or die("Unable to open skeleton " . $config->skeleton() ); |
or die("Unable to open skeleton " . $config->skeleton() ); |
134 |
|
|
135 |
$zot = Zot->new($config->zotfile); |
$zot = Zot->new($config->zotfile); |
136 |
$zot->parse(); |
$zot->parse; |
137 |
|
|
138 |
undef $/; |
undef $/; |
139 |
$skel = <SKELETON>; |
$skel = <SKELETON>; |
148 |
push @conditions, history_conditions($zot, $_); |
push @conditions, history_conditions($zot, $_); |
149 |
} |
} |
150 |
|
|
|
my %results = ( 'TABLES' => join( ', ', map( $_->name, @tables ), @histables ), |
|
|
'HISTORYTABLES' => join( ', ', @histables ), |
|
|
'CONDITIONS' => "@conditions" ); |
|
151 |
|
|
152 |
$results{uc $_} = $config->get($_) |
my %results = ($config->varlist('.')); |
153 |
foreach qw(form database sorter); |
$results{'histables'} = join ', ', @histables; |
154 |
|
$results{'tables'} = join( ', ', map( $_->name, @tables ), $results{'histables'}); |
155 |
|
$results{'conditions'} = "@conditions"; |
156 |
|
$results{'id'} = $results{table}.'.id'; |
157 |
|
|
158 |
|
$zot->add_history; |
159 |
|
push @tables, map $zot->table($_), @histables; |
160 |
|
|
161 |
|
my $tmp=0; |
162 |
|
foreach my $i (0..$#{ $results{'search_by'}}) |
163 |
|
{ |
164 |
|
my $field = $results{'search_by'}[$i]; |
165 |
|
my ($table) = grep $_->attr($field), @tables; |
166 |
|
if (!$table) |
167 |
|
{ |
168 |
|
($table) = grep $_->rel($field), @tables; |
169 |
|
} |
170 |
|
print STDERR Dumper [ $table, $field, \@tables ]; |
171 |
|
my $attr = $table->attr($field); |
172 |
|
my $width = 0; |
173 |
|
|
174 |
foreach my $class qw(page box label) |
if ($attr eq 'text') |
175 |
{ |
{ |
176 |
$results{"\U${class}_${_}"} = $config->get($class)->{$_} |
$width = $MAX_WIDTH; |
177 |
foreach (keys %{ $config->get($class) }); |
} |
178 |
|
elsif ($attr =~ m/\((\d+)\)/) |
179 |
|
{ |
180 |
|
$width = $1; |
181 |
|
} |
182 |
|
else |
183 |
|
{ |
184 |
|
$width = $DEFAULT_WIDTH; |
185 |
|
} |
186 |
|
$results{'search_width'}[$i] = ++$width ; # el +1 es por gnue que hace las cosas demasiado chicas |
187 |
|
$tmp += $width; |
188 |
} |
} |
189 |
|
$results{'search_width'}[$_] = int sprintf "%.0f", $results{'search_width'}[$_] * 80 / $tmp |
190 |
foreach my $table (reverse @tables) |
foreach (0..$#{ $results{'search_width'} }); |
191 |
{ |
$results{'search_x'}[0] = 1; |
192 |
my $table_name = $table->name; |
$results{'search_x'}[$_] = $results{'search_x'}[$_-1] + $results{'search_width'}[$_-1] |
193 |
foreach my $field ($table->attrs) |
foreach (1..$#{ $results{'search_width'} }); |
194 |
|
|
195 |
|
foreach my $i (0..$#{ $results{'field'} }) |
196 |
|
{ |
197 |
|
my $field = $results{'field'}[$i]; |
198 |
|
my ($table) = grep $_->attr($field), @tables; |
199 |
|
if (!$table) |
200 |
{ |
{ |
201 |
my $field_name = "FIELD_\U$field"; |
($table) = grep $_->rel($field), @tables; |
202 |
|
} |
203 |
if ($table->has_style('history') && $field_name ne 'id') |
my $attr = $table->attr($field); |
204 |
{ |
if ($attr eq 'text') |
205 |
$results{$field_name} = "_${table_name}_data.$field"; |
{ |
206 |
} |
$results{'width'}[$i] ||= $DEFAULT_TEXT_WIDTH; |
207 |
else |
$results{'height'}[$i] ||= 5; |
208 |
{ |
} |
209 |
$results{$field_name} = "$table_name.$field"; |
else |
210 |
} |
{ |
211 |
|
my $width = $DEFAULT_WIDTH; |
212 |
|
$attr =~ m/\((\d+)\)/; |
213 |
|
$width = $1+1 |
214 |
|
if $1; |
215 |
|
$width = $MAX_WIDTH |
216 |
|
if $width > $MAX_WIDTH; |
217 |
|
$results{'width'}[$i] ||= $width || $DEFAULT_WIDTH; |
218 |
|
$results{'height'}[$i] ||= 1; |
219 |
} |
} |
220 |
|
$results{'fqdn'}[$i] ||= sprintf "%s.%s", $table->name, $field; |
221 |
} |
} |
222 |
|
|
223 |
push @tables, @histables; |
$skel =~ s/\@\_DO\_SEARCHERS\_\@(.*?)\@\_DONE\_\@/repeat($1, $results{'search_by'})/ges; |
224 |
|
$skel =~ s/\@\_DO_FIELDS\_\@\s*(.*?)\s*\@\_DONE\_\@\s*/repeat($1, $results{'label'})/ges; |
225 |
|
$skel =~ s/\@\{(.*?)\}\@/\@$1;''\@/gs; |
226 |
$results{'FIELD_ID'} ||= "$tables[0].id"; |
$skel =~ s/(\@.*?\@)/expand_vars($1)/ges; |
227 |
|
$skel =~ s/\@(.*?)\@/eval $1/ges; |
|
$skel =~ s/\@\@DO\@\@(.*?)\@\@DONE\@\@/repeat($1, \%results, $zot)/ges; |
|
|
|
|
|
$skel =~ s/\@\_([A-Z_]+)\_\@/$results{$1}||"XXXX UNDEFINED ($1) XXXX"/ge; |
|
228 |
|
|
229 |
print $skel; |
print $skel; |