/[papo]/papo/zot/zot2gfd.pl
ViewVC logotype

Diff of /papo/zot/zot2gfd.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by jlenton, Wed Nov 27 02:30:40 2002 UTC revision 1.4 by jlenton, Mon Dec 2 02:11:08 2002 UTC
# Line 11  use lib "$ENV{HOME}/public_perl/"; Line 11  use lib "$ENV{HOME}/public_perl/";
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  {  {
# Line 34  sub parent_condition Line 36  sub parent_condition
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    
# Line 61  sub history_conditions Line 70  sub history_conditions
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    
# Line 104  my $config = AppConfig->new({ CASE => 1, Line 108  my $config = AppConfig->new({ CASE => 1,
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    
# Line 122  open SKELETON, $config->skeleton Line 133  open SKELETON, $config->skeleton
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>;
# Line 137  foreach (@tables) Line 148  foreach (@tables)
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;

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26