lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / DerivedSchema.pm

package Lire::DerivedSchema;

# vim:syntax=perl

use strict;

use base qw/ Lire::DlfSchema /;

use Lire::DataTypes qw/ check_superservice check_xml_name /;
use Lire::Utils qw/check_param check_object_param/;

use Carp;

=pod

=head1 NAME

Lire::DerivedSchema - Defines a schema for which the records are derived from another schema

=head1 SYNOPSIS

  my $schema = Lire::DlfSchema::load_schema( 'www-user_session' );
  my $fields = $schema->fields();

=head1 DESCRIPTION

A Lire::DerivedSchema defines a schema for which the records are
computed by an analyser using the records of a base schema. An example
of a derived schema is the www-user_session schema which computes
session information from the records in the www schema.

=cut

sub new {
    my ( $class, %attr ) = @_;

    check_param( $attr{'id'}, 'id', \&check_xml_name );

    my ( $super) =  $attr{'id'} =~ /^(\w+)-/
      or croak "cannot find superservice in id: '$attr{'id'}'";

    croak "invalid superservice in id: $super"
      unless check_superservice( $super );

    croak "missing base-schema attribute"
      unless exists $attr{'base-schema'};
    my $schema = Lire::DlfSchema::load_schema( $attr{'base-schema'} );
    croak "superservice of base schema doesn't match one in id: ",
      $schema->superservice(), " != $super"
	if $schema->superservice() ne $super;

    croak "base schema cannot be an extended schema: $attr{'base-schema'}"
      if $schema->isa( 'Lire::ExtendedSchema' );

    check_param( $attr{'timestamp'}, 'timestamp' );

    my $self = $class->SUPER::new( 'timestamp'	=> $attr{'timestamp'},
				   'superservice' => $super,
				 );
    $self->{'id'} = $attr{'id'};
    $self->{'base'} = $schema;

    return $self;
}

=pod

=head2 base()

Returns the Lire::DlfSchema object from which this schema's records are
derived.

=cut

sub base {
    return $_[0]->{'base'};
}

=pod

=head2 can_join_schema( $schema ) 

Returns true if $schema can be joined with this schema. For a
DerivedSchema, this will be true only when $schema is an
ExtendedSchema of this schema or this schema's base. It is also
possible to join the DerivedSchema with its base.

=cut

sub can_join_schema {
    my ( $self, $schema ) = @_;

    check_object_param( $schema, 'schema', 'Lire::DlfSchema' );

    return ( $schema eq $self->base()
             || ( $schema->isa( 'Lire::ExtendedSchema' )
                  && ( $schema->base() eq $self
                       || $schema->base() eq $self->base() ) ) );
}

sub module {
    my $self = $_[0];

    my $module = $self->{'module'};
    eval "use $module;";
    croak "error loading $module module: $@\n" if $@;

    my $analyser = eval {
	no strict 'refs';
	$module->new( $self )
    };
    croak "error creating $module instance: $@" if $@;
    croak "$module module isn't of type Lire::DerivedSchema::DerivedRecordsCreator"
      unless UNIVERSAL::isa( $self->{'module'},
			     "Lire::DerivedSchema::DerivedRecordsCreator",
			   );
    return $analyser;
}

sub create_sql_schema {
    my ( $self, $store ) = @_;

    unless ( $store->has_dlf_stream( $self->base()->id() ) ) {
        $self->base()->create_sql_schema( $store );
    }
    $self->SUPER::create_sql_schema( $store );

    $store->_dbh()->do( sprintf( "CREATE TABLE %s ( src_id INT, link_id INT )",
                           $self->sql_table( "", "_links" ) ) );

    $store->_dbh()->do( sprintf( "CREATE INDEX %s ON %s ( src_id )",
                               $self->sql_table( "", "_links_src_id_idx" ),
                               $self->sql_table( "", "_links" ) ) );

    $store->_dbh()->do( sprintf( "CREATE INDEX %s ON %s ( link_id )",
                               $self->sql_table( "", "_links_link_id_idx" ),
                               $self->sql_table( "", "_links" ) ) );

    $store->_dbh()->do( sprintf( q{CREATE TRIGGER %s AFTER DELETE ON %s
BEGIN
    DELETE FROM %s WHERE src_id = old.dlf_id;
END
},
                                 $self->sql_table( '', '_delete_trigger' ),
                                 $self->base()->sql_table(),
                                 $self->sql_table( '', '_links' )
                               ) );

    $store->_dbh()->do( sprintf( q{CREATE TRIGGER %s AFTER DELETE ON %s
BEGIN
    DELETE FROM %s WHERE src_id = old.dlf_id;
END
},
                                $self->sql_table( '', '_links_delete_trigger'),
                                $self->sql_table(),
                                $self->sql_table( '', '_links' ) ) );
    return;
}

sub sql_link_insert_query {
    my $self = $_[0];

    return sprintf( 'INSERT INTO %s (src_id, link_id) VALUES(?, ?)',
                    $self->sql_table( '', '_links' ) );
}

# keep perl happy
1;

__END__

=pod

=head1 AUTHOR

Francis J. Lacoste <flacoste@logreport.org>

=head1 VERSION

$Id: DerivedSchema.pm,v 1.19 2006/07/23 13:16:28 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2001, 2004 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html. 

=cut