/[papo]/papo/neb/PAPO/DataSource.pm
ViewVC logotype

Diff of /papo/neb/PAPO/DataSource.pm

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

revision 1.1 by jlenton, Wed Apr 23 20:24:55 2003 UTC revision 1.2 by jlenton, Fri Apr 25 18:37:56 2003 UTC
# Line 1  Line 1 
1  # -*- cperl -*-  # -*- cperl -*-
2  package PAPO::DataSource;  package PAPO::DataSource;
3  use strict;  use strict;
4  use warnings;  use warnings;
5    use English;
6  use Data::Dumper;  use Data::Dumper;
7  use Carp;  use Carp;
8  use lib $ENV{HOME} . '/public_perl';  use lib "$ENV{HOME}/public_perl";
9  use Zot;  use Zot;
10    use PAPO::Condition;
11    
12    
13  =head1 NAME  =head1 NAME
14    
15  PAPO::DataSource - Perl module for the generation of PAPO-flavoured GNUe datasources  PAPO::DataSource - Perl class for the generation of PAPO-flavoured
16    GNUe datasources
17    
18  =head1 SYNOPSIS  =head1 SYNOPSIS
19    
20      use PAPO::DataSource '/path/to/PAPO-ER.zot';      use PAPO::DataSource;
21    
22        my $ds = PAPO::DataSource->new("/path/to/PAPO-ER.zot",
23                                       name => "fooDataSource",
24                                       cache => 1);
25        $ds->query("client");
26        $ds->dated_join("client", "own_document");
27        print $ds->datasource;
28    
29  =head1 DESCRIPTION  =head1 DESCRIPTION
30    
31  Calculating GNUe datasources for slighly complex databases, such as  Calculating GNUe datasources for slighly complex databases, such as
32  the one used for PAPO, is a daunting task. The object of this module  the one used for PAPO, is a daunting task. The object of this class
33  is to automate said task away as much as possible.  is to automate said task away as much as possible.
34    
35  On importing this module the parameter given is used to locate and  =cut
36  parse de zot definition of the database. Not providing this  
37  information is an error.  
38    =head1 METHODS
39    
40    =head2 new
41    
42    Returns a new PAPO::DataSource object. If called as a class method,
43    requires a parameter (the location of the zot file). If called as an
44    instance method, returns a new object that uses the same zot as the
45    original instance.
46    
47    Any further arguments are interpreted as key/value pairs of the
48    datasource.
49    
50    [ FIXME: explain better ]
51    
52  =cut  =cut
53    
54  our $zot;  sub new
55    {
56        my $thing = shift;
57        my $class = ref($thing) || $thing;
58        my $self = bless {}, $class;
59    
60        unshift @_, $thing->zot
61            if ref $thing;
62    
63        $self->init(@_);
64    
65        return $self;
66    }
67    
68    
69    
70  # I am a hack. Please ignore me.  =head2 init
71  sub import  
72    Performs any required initialization.
73    
74    =cut
75    
76    sub init
77  {  {
78      $zot = Zot->new($_[1])->parse;      my $self = shift;
79        my $zot = shift;
80    
81        $self->zot($zot);
82        $self->{ATTRS} = {};
83        $self->{TABLES} = [];
84        $self->{HISTORY_TABLES} = [];
85        $self->condition(new PAPO::Condition);
86    
87        $self->attributes(@_);
88    
89        return $self;
90  }  }
 # Ok, you can stop ignoring me.  
91    
92    
93    =head2 attributes
94    
95  =head1 FUNCTIONS  Sets/gets the current attributes hash.
96    
97  None of the functions below are exported.  =cut
98    
99  =head2 simple  sub attributes
100    {
101        my $self = shift;
102        my %attrs = (@_);
103    
104  Given the name of an object (e.g. C<client>), this function returns      $self->{ATTRS}->{$_} = $attrs{$_}
105  the datasource definition fragment that could be used for a form that          foreach (keys %attrs);
 manipulates the object.  
106    
107  If the object's table is transactional, the datasource joins against      return $self->{ATTRS};
108  the transactional tables as well as the object hierarchy tables.  }
109    
110    =head2 zot
111    
112  If the object's table is non-transactional, it doesn't.  This method is slightly overloaded on its parameters. When called
113    without any parameter, it simply returns the associated Zot. When
114    called with a reference, this reference is assumed to be a Zot and
115    used from then on. When called with a scalar, it is assumed to be the
116    filename of a zot file, which is loaded, parsed, and used.
117    
118      Currently this checks at every level if the table is transactional  =cut
119      or not. Given the way we to things, it's probably not needed. Note  
120      the B<probably> bit.  sub zot
121    {
122        my $self = shift;
123        my $zot = shift;
124    
125        if (defined $zot)
126        {
127            if (ref $zot)
128            {
129                $self->{ZOT} = $zot;
130            }
131            else
132            {
133                my $file = $zot;
134                my @path = split(":", $ENV{'ZOT_PATH'}||".");
135    
136                foreach my $dir (reverse @path)
137                {
138                    $file = "$dir/$zot" if -f "$dir/$zot";
139                }
140    
141                $self->{ZOT} = Zot->new($file)->parse;
142            }
143        }
144    
145        return $self->{ZOT};
146    }
147    
148    
149    =head2 condition
150    
151    This method provides a link to the associated PAPO::Condition object.
152    
153  =cut  =cut
154    
155  sub simple  sub condition
156  {  {
157        my $self = shift;
158        my $condition = shift;
159    
160        $self->{CONDITION} = $condition
161            if defined $condition;
162    
163        return $self->{CONDITION};
164    }
165    
166    
167    =head2 query
168    
169    Given the name of an object (e.g. C<client>), this method adds to the
170    datasource definition the conditions that could be used for a form
171    that manipulates the object, as well as the tables needed for the from
172    clause.
173    
174    If the object's tables are transactional, the datasource joins against
175    the transactional tables as well as the object hierarchy tables.
176    
177    If the object's table are non-transactional (instantaneous), it
178    doesn't.
179    
180    =cut
181    
182    sub query
183    {
184        my $self = shift;
185      my $table = shift;      my $table = shift;
186      my @tables = ($table);      my @tables = ($table);
187    
188      push @tables, $table      push @tables, $table
189          while ($table = $zot->table($table)->parent);          while ($table = $self->zot->table($table)->parent);
190    
191      my $out = '';      $self->add_table($_)
192            foreach (@tables);
193    
194      foreach $table (map $zot->table($tables[$_]), 0..$#tables-1)      foreach $table (map $self->zot->table($tables[$_]), 0..$#tables-1)
195      {      {
196            if ($table->has_style('history'))
197          $out .= transactional_join($table)          {
198              if ($table->has_style('history'));              $self->condition->transactional_join($table);
199          $out .= child_join($table);              $self->add_table(sprintf "_%s_data", $table->name);
200                $self->add_history_table(sprintf "_%s_data", $table->name);
201            }
202            $self->condition->child_join($table);
203      }      }
204    
205      $table = $zot->table($tables[-1]);      $table = $self->zot->table($tables[-1]);
206    
207      $out .= transactional_join($table)      if ($table->has_style('history'))
208          if ($table->has_style('history'));      {
209            $self->condition->transactional_join($table);
210            $self->add_table(sprintf "_%s_data", $table->name);
211            $self->add_history_table(sprintf "_%s_data", $table->name);
212        }
213    
214      return $out;      return $self;
215  }  }
216    
217    
218    =head2 search
 =head2 query  
219    
220  Given the name of an object (e.g. C<client>), this function returns  Given the name of an object (e.g. C<client>), this function returns
221  the datasource definition fragment that could be used for a form that  the datasource definition fragment that could be used for a form that
# Line 99  quick way. Line 227  quick way.
227    
228  =cut  =cut
229    
230  sub query  sub search
231  {  {
232        my $self = shift;
233      my $table = shift;      my $table = shift;
234      my @tables = ($table);      my @tables = ($table);
235    
236      push @tables, $table      push @tables, $table
237          while ($table = $zot->table($table)->parent);          while ($table = $self->zot->table($table)->parent);
238    
239      my $out = '';      foreach $table (map $self->zot->table($tables[$_]), 0..$#tables-1)
   
     foreach $table (map $zot->table($tables[$_]), 0..$#tables-1)  
240      {      {
241            if ($table->has_style('history'))
242          $out .= transactional_join($table)          {
243              if ($table->has_style('history'));              $self->condition->transactional_child_join($table);
244          $out .= child_join($table);              $self->add_table(sprintf "_%s_data", $table->name);
245            }
246            else {
247                $self->condition->child_join($table);
248                $self->add_table($table->name);
249            }
250      }      }
251    
252      $table = $zot->table($tables[-1]);      $table = $self->zot->table($tables[-1]);
253    
254      $out .= transactional_join($table)      if ($table->has_style('history'))
255          if ($table->has_style('history'));      {
256            $self->add_table(sprintf "_%s_data", $table->name);
257        }
258        else
259        {
260            $self->add_table($table->name);
261        }
262    
263      return $out;      return $self;
264  }  }
265    
266    
267  =head2 dated  =head2 dated
268    
269  Given the name of two objects (e.g. C<own_document> and  Given the name of two objects (e.g. C<own_document> and
# Line 132  C<entity_uid>), this function returns th Line 271  C<entity_uid>), this function returns th
271  fragment that could be used to join the two objects based on their  fragment that could be used to join the two objects based on their
272  dates.  dates.
273    
274  Both objects must be either transactional or have an attribute 'date';  Both objects must be either transactional or have an attribute 'date'
275  this is true of all joins of this kind you might want to do in PAPO  (or the optional third parameter); this is true of all joins of this
276  (either an object is transactional, or it is a dated snapshot).  kind you might want to do in PAPO (either an object is transactional,
277    or it is a dated snapshot).
278    
279  If you join two transactional objects, the resulting fragment will  If you join two transactional objects, the resulting fragment will
280  demand the second one be active for the whole life of the first one.  demand the second one be active for the whole life of the first one.
# Line 143  Note that trying to join two snapshot ta Line 283  Note that trying to join two snapshot ta
283    
284  You can also call it with two Zot::Tables, instead.  You can also call it with two Zot::Tables, instead.
285    
286    This keeps track of the tables used, but not the 'history_tables'. Is
287    this a bug?
288    
289  =cut  =cut
290    
291  sub dated  sub dated
292  {  {
293      my $table_a = ref $_[0] ? $_[0] : $zot->table($_[0]);      my $self = shift;
294      my $table_b = ref $_[1] ? $_[1] : $zot->table($_[1]);      my $table_a = shift;
295      my $out = '';      my $table_b = shift;
296        my $date = shift || 'date';
297    
298        $table_a = $self->zot->table($table_a)
299            unless ref $table_a;
300        $table_b = $self->zot->table($table_b)
301            unless ref $table_b;
302    
303      my $hist_a = $table_a->has_style('history');      my $hist_a = $table_a->has_style('history');
304      my $hist_b = $table_b->has_style('history');      my $hist_b = $table_b->has_style('history');
305    
306      if (not ( $hist_a or $hist_b) )      if (not ( $hist_a or $hist_b) )
307      {      {
308          $out = sprintf(<<EOF,  
309          <!-- pega %s con %s por fecha -->          $self->condition->simple($table_a, $table_b,
310          <eq>                                   $table_a => $date,
311            <cfield name="%s.date"/>                                   $table_b => $date);
312            <cfield name="%s.date"/>          $self->add_table($table_a->name);
313          </eq>          $self->add_table($table_b->name);
 EOF  
                        $table_a->name, $table_b->name,  
                        $table_a->name, $table_b->name );  
314      }      }
315      elsif ($hist_a and not $hist_b)      elsif ($hist_a and not $hist_b)
316      {      {
317          $out = sprintf(<<EOF,          $self->condition->raw(<<EOF,
318          <!-- pega %s con %s por fecha -->          <!-- pega %s con %s por fecha -->
319          <and>          <and>
320            <le>            <le>
321              <cfield name="_%s_data._start_t"/>              <cfield name="_%s_data._start_t"/>
322              <cfield name="%s.date"/>              <cfield name="%s.%s"/>
323            </le>            </le>
324            <or>            <or>
325              <null>              <null>
326                <cfield name="_%s_data._end_t"/>                <cfield name="_%s_data._end_t"/>
327              </null>              </null>
328              <le>              <le>
329                <cfield name="%s.date"/>                <cfield name="%s.%s"/>
330                <cfield name="_%s_data._end_t"/>                <cfield name="_%s_data._end_t"/>
331              </le>              </le>
332            </or>            </or>
333          </and>          </and>
334  EOF  EOF
335                         $table_a->name, $table_b->name,                         $table_a, $table_b,
336                         $table_a->name, $table_b->name,                         $table_a, $table_b, $date,
337                         $table_b->name,                         $table_a,
338                         $table_b->name, $table_a->name );                         $table_b, $date, $table_a );
339    
340            $self->add_table(sprintf "_%s_data", $table_a->name);
341            $self->add_table($table_b->name);
342      }      }
343      elsif ($hist_b and not $hist_a)      elsif ($hist_b and not $hist_a)
344      {      {
345          $out = dated($table_b, $table_a);          $self->dated($table_b, $table_a);
346      }      }
347      else      else
348      {      {
349          $out = sprintf(<<EOF,          $self->condition->raw(<<EOF,
350          <!-- pega %s con %s por fecha -->          <!-- pega %s con %s por fecha -->
351          <and>          <and>
352            <le>            <le>
# Line 215  EOF Line 364  EOF
364            </or>            </or>
365          </and>          </and>
366  EOF  EOF
367                         $table_a->name, $table_b->name,                         $table_a, $table_b,
368                         $table_b->name, $table_a->name,                         $table_b, $table_a,
369                         $table_b->name,                         $table_b,
370                         $table_a->name, $table_b->name );                         $table_a, $table_b );
371    
372            $self->add_table(sprintf "_%s_data", $table_a->name);
373            $self->add_table(sprintf "_%s_data", $table_b->name);
374      }      }
375    
376      return $out;      return $self;
377  }  }
378    
379    
380    
381  =head2 transactional_join  sub datasource
382    {
383        my $self = shift;
384    
385        my %h = %{$self->attributes};
386        my $ds = '  <datasource';
387    
388        $ds .= " $_=\"$h{$_}\""
389            foreach (keys %h);
390    
391        $ds .= ' tables="' . join(',', $self->tables) . '"'
392            if ($self->tables);
393    
394  Given a Zot::Table object this returns the GCondition fragment that      $ds .= ' historytable="' . join(',', $self->history_tables) . '"'
395  joins the table with its transactional table.          if ($self->history_tables);
396    
397        $ds .= ">\n";
398    
399        if ($self->conditions)
400        {
401            $ds .= "    <condition>\n";
402            $ds .= "      <and>\n";
403            $ds .= $self->conditions;
404            $ds .= "      </and>\n";
405            $ds .= "    </condition>\n";
406        }
407    
408        $ds .= "  </datasource>\n";
409    
410        $ds;
411    }
412    
413    
414    =head2 conditions
415    
416    Returns the content of the PAPO::Condition object.
417    
418  =cut  =cut
419    
420  sub transactional_join  sub conditions { $_[0]->condition->dump }
421    
422    
423    =head2 add_table
424    
425    This method returns the current tables associated with the object,
426    previously adding the table that might be passed as a parameter.
427    
428    =cut
429    
430    sub add_table
431  {  {
432        my $self = shift;
433      my $table = shift;      my $table = shift;
434    
435      sprintf( <<EOF,      push @{$self->{TABLES}}, $table
436          <!-- pega %s con su _table -->          if defined $table;
437          <eq>  
438            <cfield name="%s.id"/>      return @{$self->{TABLES}};
439            <cfield name="_%s_data._table"/>  }
440          </eq>  
441  EOF  =head2 tables
442               $table->name, $table->name, $table->name );  
443    Returns a uniqified list of the tables associated with the datasource,
444    in an order that tries to be easy to follow. Suitable for table=""
445    stuff.
446    
447    =cut
448    
449    
450    sub tables
451    {
452        my $self = shift;
453        my %idx = ();
454        my @tables = ();
455    
456        foreach (@{$self->{TABLES}}) {
457            push(@tables, $_),
458                $idx{$_}++
459                    unless $idx{$_};
460        }
461    
462        return @tables;
463  }  }
464    
465    =head2 add_history_table
466    
467    This method returns the current history_tables associated with the
468    object, previously adding the history_table that might be passed as a
469    parameter.
470    
471    =cut
472    
473    sub add_history_table
474    {
475        my $self = shift;
476        my $history_table = shift;
477    
478  =head2 child_join      push @{$self->{HISTORY_TABLES}}, $history_table
479            if defined $history_table;
480    
481  Given a Zot::Table object this returns the GCondition fragment that      return @{$self->{HISTORY_TABLES}};
482  joins the table with its parent.  }
483    
484    =head2 history_tables
485    
486    Returns a uniqified list of the history_tables associated with the
487    datasource, in an order that tries to be easy to follow. Suitable for
488    historytable="" stuff.
489    
490  =cut  =cut
491    
492  sub child_join  
493    sub history_tables
494  {  {
495      my $table = shift;      my $self = shift;
496        my %idx = ();
497        my @history_tables = ();
498    
499        foreach (@{$self->{HISTORY_TABLES}}) {
500            push(@history_tables, $_),
501                $idx{$_}++
502                    unless $idx{$_};
503        }
504    
505      sprintf( <<EOF,      return @history_tables;
         <!-- pega %s con su %s -->  
         <eq>  
           <cfield name="%s.%s"/>  
           <cfield name="%s.id"/>  
         </eq>  
 EOF  
              $table->name, $table->parent,  
              sprintf($table->has_style('history') ? "%s_data" : "%s",  
                      $table->name), $table->parent,  
              $table->parent);  
506  }  }
507    
508    =head1 ENVIRONMENT VARIABLES
509    
510    C<ZOT_PATH> is the search path for zot files.
511    
512  =head1 SEE ALSO  =head1 SEE ALSO
513    
514  L<Zot>  L<Zot>, L<PAPO::Condition>
515    
516  =head1 AUTHOR  =head1 AUTHOR
517    
# Line 294  Please refer to the file "COPYING" for d Line 530  Please refer to the file "COPYING" for d
530    
531  =head1 BUGS  =head1 BUGS
532    
533  None. Really.  None. Really. Other than... well, you'll find it soon enough.
534    
535  =cut  =cut
536    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

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