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

package Lire::ExtendedSchema;

# vim:syntax=perl

use strict;

use base qw/ Lire::DlfSchema /;

use Carp;

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

=pod

=head1 NAME

Lire::ExtendedSchema - Adds fields to each DLF records of a base schema

=head1 SYNOPSIS

  my $schema = Lire::DlfSchema::load_schema( 'www-robot' );
  my $ext_fields = $schema->extended_fields();

=head1 DESCRIPTION

A Lire::ExtendedSchema defines a DlfSchema which adds fields to each
records of a base DlfSchema. The values of the extended fields are
usually computed from values based on the values of the fields in the
base Dlf record. These values aren't written by Lire::DlfConverters,
but by Lire::DlfAnalysers (or usually a Lire::DlfCategoriser).

=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 );

    check_param( $attr{'base-schema'}, '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' );

    my $self = $class->SUPER::new( 'timestamp' => $schema->timestamp_field()->name(),
				   'superservice' => $super,
				 );
    $self->{'id'} = $attr{'id'};
    $self->{'base'} = $schema;
    $self->{'fields_by_pos'} = [ $schema->fields() ];
    $self->{'extended_start_idx'} = @{$self->{'fields_by_pos'}};
    $self->{'fields_by_name'} = { map { $_->name() => $_ }
                                  @{$self->{'fields_by_pos'}}};

    return $self;
}

=pod

=head2 base()

Returns the Lire::DlfSchema object for which this schema's records are
an extension.

=cut

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

=pod

=head2 can_join_schema( $schema ) 

Returns true if $schema can be joined with this schema. For an
ExtendedSchema, this will be true only when $schema is an
ExtendedSchema which shares the same same than this schema.

=cut

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

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

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

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

    return $schema eq $self->{'id'} ||
      $self->{'base'}->is_schema_compatible( $schema );
}

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

    my @fields = $self->fields();
    my $idx = $self->{'extended_start_idx'};
    return [ @fields[$idx .. $#fields] ];
}

# Extended schema only store the extended fields.
# Other fields are joined using dlf_id with the superservice's schema.
sub _sql_fields {
    my $self = $_[0];

    my @fields = $self->fields();
    my $idx = $self->{'extended_start_idx'};
    return @fields[0, # dlf_id
                   1, # dlf_source
                   $idx .. $#fields ];
}

# The dlf_id and dlf_source fields should be qualified with
# the table name
sub dlf_query {
    my ( $self, $sort_spec ) = @_;

    my $query = new Lire::DlfQuery( $self->{'id'} );
    foreach my $f ( $self->fields() ) {
        if ( $f->name() eq 'dlf_id' ||
             $f->name() eq 'dlf_source' )
        {
            $query->add_field( $f->name(), $self->sql_table() . "."
                               . $f->name() );
        } else {
            $query->add_field( $f->name() );
        }
    }

    $query->set_sort_spec( $sort_spec )
      if $sort_spec;

    return $query;
}

# When using a time delimiter, we need an inner join with the
# superservice's table to access the timestamp field.
sub sql_clean_query {
    my ( $self, $with_time ) = @_;

    return $self->SUPER::sql_clean_query() unless $with_time;

    my $super = Lire::DlfSchema::load_schema( $self->superservice() );

    return sprintf( 'DELETE FROM %s WHERE dlf_id IN ( SELECT e.dlf_id FROM %s b, %s e WHERE b.dlf_id = e.dlf_id AND %s < ? )',
                    $self->sql_table(),
                    $super->sql_table(),
                    $self->sql_table(),
                    sql_quote_name( "b." . $self->{'timestamp_field'} ) );
}

# When using a time delimiter, we need an inner join with the
# superservice's table to access the timestamp field.
sub sql_clean_period_query {
    my $self = $_[0];

    my $super = Lire::DlfSchema::load_schema( $self->superservice() );

    return sprintf( 'DELETE FROM %s WHERE dlf_id IN ( SELECT e.dlf_id FROM %s b, %s e WHERE b.dlf_id = e.dlf_id AND %s >= ? AND %s < ? )',
                    $self->sql_table(),
                    $super->sql_table(),
                    $self->sql_table(),
                    sql_quote_name( "b." . $self->{'timestamp_field'} ),
                    sql_quote_name( "b." . $self->{'timestamp_field'} ) );
}


# Since the timestamp field is only stored in the base schema's 
# table. We do not need to create the index.
sub create_sql_schema {
    my ($self, $store, $remove ) = @_;

    check_object_param( $store, 'store', 'Lire::DlfStore' );

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

    $store->_dbh()->do( "DROP TABLE " . $self->sql_table() )
      if $remove;
    $store->_dbh()->do( $self->_create_sql_table_query() );

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

# keep perl happy
1;

__END__

=pod

=head1 SEE ALSO

Lire::DlfSchema(3pm), Lire::DerivedSchema(3pm),
Lire::DlfAnalyser(3pm), Lire::DlfCategoriser(3pm)

=head1 AUTHOR

  Francis J. Lacoste <flacoste@logreport.org>

=head1 VERSION

$Id: ExtendedSchema.pm,v 1.24 2006/07/23 13:16:29 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2001 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