# -*- cperl -*- package PAPO::DataSource; use strict; use warnings; use Data::Dumper; use Carp; use lib $ENV{HOME} . '/public_perl'; use Zot; =head1 NAME PAPO::DataSource - Perl module for the generation of PAPO-flavoured GNUe datasources =head1 SYNOPSIS use PAPO::DataSource '/path/to/PAPO-ER.zot'; =head1 DESCRIPTION Calculating GNUe datasources for slighly complex databases, such as the one used for PAPO, is a daunting task. The object of this module is to automate said task away as much as possible. On importing this module the parameter given is used to locate and parse de zot definition of the database. Not providing this information is an error. =cut our $zot; # I am a hack. Please ignore me. sub import { $zot = Zot->new($_[1])->parse; } # Ok, you can stop ignoring me. =head1 FUNCTIONS None of the functions below are exported. =head2 simple Given the name of an object (e.g. C), this function returns the datasource definition fragment that could be used for a form that manipulates the object. If the object's table is transactional, the datasource joins against the transactional tables as well as the object hierarchy tables. If the object's table is non-transactional, it doesn't. Currently this checks at every level if the table is transactional or not. Given the way we to things, it's probably not needed. Note the B bit. =cut sub simple { my $table = shift; my @tables = ($table); push @tables, $table while ($table = $zot->table($table)->parent); my $out = ''; foreach $table (map $zot->table($tables[$_]), 0..$#tables-1) { $out .= transactional_join($table) if ($table->has_style('history')); $out .= child_join($table); } $table = $zot->table($tables[-1]); $out .= transactional_join($table) if ($table->has_style('history')); return $out; } =head2 query Given the name of an object (e.g. C), this function returns the datasource definition fragment that could be used for a form that performs searches on the object. If the object's table is transactional, the datasource joins against the transactional tables as well as the object hierarchy tables, the quick way. =cut sub query { my $table = shift; my @tables = ($table); push @tables, $table while ($table = $zot->table($table)->parent); my $out = ''; foreach $table (map $zot->table($tables[$_]), 0..$#tables-1) { $out .= transactional_join($table) if ($table->has_style('history')); $out .= child_join($table); } $table = $zot->table($tables[-1]); $out .= transactional_join($table) if ($table->has_style('history')); return $out; } =head2 dated Given the name of two objects (e.g. C and C), this function returns the datasource definition fragment that could be used to join the two objects based on their dates. Both objects must be either transactional or have an attribute 'date'; this is true of all joins of this kind you might want to do in PAPO (either an object is transactional, or it is a dated snapshot). If you join two transactional objects, the resulting fragment will demand the second one be active for the whole life of the first one. Note that trying to join two snapshot tables by their dates is racing. You can also call it with two Zot::Tables, instead. =cut sub dated { my $table_a = ref $_[0] ? $_[0] : $zot->table($_[0]); my $table_b = ref $_[1] ? $_[1] : $zot->table($_[1]); my $out = ''; my $hist_a = $table_a->has_style('history'); my $hist_b = $table_b->has_style('history'); if (not ( $hist_a or $hist_b) ) { $out = sprintf(< EOF $table_a->name, $table_b->name, $table_a->name, $table_b->name ); } elsif ($hist_a and not $hist_b) { $out = sprintf(< EOF $table_a->name, $table_b->name, $table_a->name, $table_b->name, $table_b->name, $table_b->name, $table_a->name ); } elsif ($hist_b and not $hist_a) { $out = dated($table_b, $table_a); } else { $out = sprintf(< EOF $table_a->name, $table_b->name, $table_b->name, $table_a->name, $table_b->name, $table_a->name, $table_b->name ); } return $out; } =head2 transactional_join Given a Zot::Table object this returns the GCondition fragment that joins the table with its transactional table. =cut sub transactional_join { my $table = shift; sprintf( < EOF $table->name, $table->name, $table->name ); } =head2 child_join Given a Zot::Table object this returns the GCondition fragment that joins the table with its parent. =cut sub child_join { my $table = shift; sprintf( < EOF $table->name, $table->parent, sprintf($table->has_style('history') ? "%s_data" : "%s", $table->name), $table->parent, $table->parent); } =head1 SEE ALSO L =head1 AUTHOR John Lenton Please report any bugs, or post any suggestions, to the papo-hackers mailing list =head1 COPYRIGHT Copyright (C)2003 Fundación Vía Libre. This is free software; you can redistribute it and/or modify it under the terms of the "GNU General Public License". Please refer to the file "COPYING" for details. =head1 BUGS None. Really. =cut 1;