package ARDB;  #  Abstract RePEc Database


use strict;

use Data::Dumper;
use Carp::Assert;


use ARDB::Configuration;
use sql_helper;
use ARDB::Common;
use ARDB::SiteConfig;
use ARDB::ObjectDB;
use ARDB::LocalConfig;

use vars qw( $VERSION );



$VERSION= do { my @r=(q$Revision: 1.49 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
# $Id: ARDB.pm,v 1.49 2003/08/06 12:45:10 ivan Exp $;


sub new 
 { 
  my $class = shift;

  my $home  = shift;

  if ( not defined $home ) {
    $home = $ARDB::LocalConfig::local_path;
  }

  assert( $home );

  $ARDB::Common::LOGFILENAME = $home . '/ardb.log';


  debug "try to retrieve configuration from ARDB::SiteConfig";
  my $site_config = new ARDB::SiteConfig( $home );

  
  # create a structure and bless it:
  my $self = 
   {
    site_config => $site_config,

    db_name     => $site_config -> db_name,
    db_user     => $site_config -> db_user,
    db_pass     => $site_config -> db_pass,
    
    config      => undef,
    sql_object  => undef,
    relations   => undef,
    plugins     => undef,

    home        => undef,
   };
    
  bless $self, $class;
  

  $self->{home}           = $home;
  $self->{object_db_file} = $home . '/objects/data.db';
  $self->{config_file}    = $home . '/configuration.xml';


  ##############
  # init class #
  ##############
  
  debug "try to connect to mysql database";

  sql_helper -> set_log_filename ( $home . '/sql.log' );

  my $sql_helper = sql_helper -> new( $self -> {db_name}, 
				      $self -> {db_user},
				      $self -> {db_pass} );

  if ( not $sql_helper ) {
    die "Can't establish database connection";
  }

  $self -> {sql_object} = $sql_helper;


  $self -> {relations} = new ARDB::Relations ( $self -> {sql_object} );

  $self -> init_config;

  return $self;
 }


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

use ARDB::Relations;
use ARDB::Plugins;
use ARDB::Relations::Transaction;

use Storable qw( &store &retrieve );

sub init_config
 {
  my $self = shift;
  
  my $config_file = $self -> {'config_file'};

  my $config_object;

  # try compare timestamps

  my $bin_config_file = $config_file . '.binary';

  debug "compare timestamps of the config file '$config_file', its binary dump '$bin_config_file' and module ARDB::Configuration";

  my $configuration_package_file = $INC {'ARDB/Configuration.pm'};
  
  ###########################################
  
  my $package_change = -M $configuration_package_file;
  my $config_change  = -M $config_file;
  my $binary_change  = -M $bin_config_file
   if -f $bin_config_file;
  
  my $last_modified = $config_change;
  my $action = 'parse';
  
  if ($package_change < $config_change)
   {
    debug "module are newer than configuration";
    $last_modified = $package_change;
    $action = 'parse';
   }
  
  if ( (-f $bin_config_file) and ($binary_change < $last_modified) )
   {
    debug "configuration binary newer than new";
    $action = 'restore';
   }
  
  ###########################################
  
  if ($action eq 'parse')
   {
    debug 'parsing configuration';

    $config_object = new ARDB::Configuration
     || critical "ARDB::Configuration did not work";

    $config_object -> parse_config ( $config_file );
    store ( $config_object, $bin_config_file )
     or log_error ( "cannot write binary config to '$bin_config_file'" );
   }
  elsif ($action eq 'restore')
   {
    debug( "loading configuration binary" );
    $config_object = retrieve ( $bin_config_file );
   }
  
  ##############################
  # place plugins deny here    #
  ##############################

  debug "try to retrieve information about plugins";

  my $plugins = new ARDB::Plugins ( $self -> {'home'}, $self );
  
  $self -> {plugins} = $plugins;

  my $plugins_list = $plugins -> start_list;

  debug "retrieve configuration of plugins and parse it";

  foreach my $plugin_desc ( @$plugins_list )
   {
    my $plugin_name = $plugin_desc -> [0];

    debug "try reading '$plugin_name' plugin configuration";

    my $plugin_config;
    my ($short_name) = ($plugin_name =~ /.*::(\w+)/);
    eval "\$plugin_config = $plugin_name -> config";
    
    critical $@
     if $@;
     
    $config_object -> parse_config ( $self -> {'home'} . "/plugins/Processing/$short_name/" . $plugin_config )
     if ( $plugin_config );

   }
 
  debug "try to compile config";
  $config_object -> compile_config;
 
  $self -> {'config'} = $config_object;
 }


###################################################################################
###  sub  P U T    R E C O R D 
###################################################################################


my $stored = {};

sub put_record # store and process record
 {
  my $self   = shift;
  my $record = shift;

  # receive all record relations, stored with source equal id of this record
  # delete all unused in this record direct relations
  # replace all changed relations
  # create new relations

  ## creating new relations
  ## map attributes by field attribute mapping
  
  assert( $record );

  my $id   = $record -> id;
  my $type = $record -> type;

  assert( $id and $type );

  if ( $stored -> {$id} ) {
    warn "Error: double put_record: $id";
    return;
  }
  assert( not $stored -> {$id} );
  $stored->{$id} = 1;

  debug "try to receive record object";

  my $o_db = $self -> { object_db_file };

  if ( not ARDB::ObjectDB::store_record( $o_db, $record ) )
   {
    log_error ( "cannot store record '$id' in ObjectDB" );
    return undef;
   }

  my $record_types      = $self -> {config} -> {record_types};
  my $processing_object = $record_types -> { $type };

  unless ( defined $processing_object )
   {
    log_error "can't process record '$id' because '$type' is not described in configuration";
    return undef;
   }
  
  my $code = $processing_object -> {'put-process-code'};
  if( $code )
   {
    debug "going to execute put-processing code";

    my $relations = $self -> {relations};
    my $transaction = new ARDB::Relations::Transaction ( $id, $relations );
    
    $transaction -> prepare;

    eval
     {
      &$code ( $self, $record, $transaction );
     };
    
    if ($@)
     { 
      log_warn "put-process-code: {" . $processing_object -> {'put-process-text'} . "}";
      critical "an error while running the processing code: $@";
     }

    debug "try to save new relations and delete old";
    
    $transaction -> commit;
   }

  debug "plugins record processing";

  my $plugins = $self -> {plugins};

  return $plugins -> process_record ( $record );
 }

################################################################################
###  sub  D E L E T E    R E C O R D 
################################################################################

sub delete_record #receive id/handle
 {
  my $self = shift;
  my $id   = shift;
  
  # receive record-type
  
  my $record = $self -> get_record( $id );

  return 0 if not $record;
  assert( $record );

  my $type   = $record -> type;
  assert( $type );

  # call perl-code for record-type
  
  my $processing_object = $self -> {config} -> {record_types} -> { $type };

  unless ( defined $processing_object )
   {
    log_error "can't process record '$id' because '$type' not described in configuration";
    return undef;
   }
    
  my $code = $processing_object -> {'delete-process-code'};

  debug "try execute delete-process-code";

  eval
   {
    &$code ( $self, $record );
   };

  if( $@ )
   { 
    log_warn "delete-process-code: {" . $processing_object->{'delete-process-text'} . "}";
    critical "an error while running the deleting code: $@";
   }


  # delete all relations assigned

  my $relations  = $self -> {'relations'};
  
  my $res = $relations -> remove ( [undef, undef, undef, $id ] );
 

  # delete the object from the ObjectDB
  my $object_db_file = $self->{object_db_file} ;
  ARDB::ObjectDB::delete_record( $object_db_file, $id );

  return 'ok';
 }


# function get one record per id and all linked records (one level)
sub get_record {
  my $self = shift;
  my $id   = shift;
  my $object_db_file = $self->{object_db_file} ;
  
  return ARDB::ObjectDB::retrieve_record( $object_db_file, $id );
}


###################################################################################
###  sub  G E T   U N F O L D E D    R E C O R D 
###################################################################################

sub get_unfolded_record
 { #receive id

  my $self = shift;
  my $id   = shift;
  my $view = shift || 'default';

  my $relation_types = $self -> {'config'} -> {'relation_types'};
  assert( $relation_types );

  my $record = $self -> get_record( $id );
  
  critical "cannot retrieve record by '$id' indentifier"
   unless ( $record );

  my $relations = $self -> {relations};


  debug( "going to check relationships for '$id'" );

  my @fw_rel = $relations -> fetch ( [$id, undef, undef, undef] );
  my @bw_rel = $relations -> fetch ( [undef, undef, $id, undef] );

  debug "found ".scalar @fw_rel." forward and ".scalar @bw_rel." backward relations";

  foreach my $relation ( @fw_rel, @bw_rel )
   {
    
    my $relation_type;
    my $relation_target;
    my $direction;
    
    my $relation_name   = $relation->[1];
    my $relation_source = $relation->[3];;
    
    #use Data::Dumper;
    #print "\nid = $id\n";
    #die Dumper $relation;
    
    if    ($relation -> [0] eq $id)
     {
      $relation_target = $relation->[2];
      $direction = 'forward';
      $relation_type   = $relation_types -> {$relation_name} ;
      
      debug "found '$direction' relation named '$relation_name'";
     }
    elsif  ($relation -> [2] eq $id)
     {
      $relation_target = $relation->[0];
      $direction = 'backward';
      
      my $forw_relation_type = $relation_types -> {$relation_name} ;
      my $relation_name   = $forw_relation_type->reverse_type;
      $relation_type   = $relation_types -> {$relation_name} ;
      
      debug "found $direction relation named '$relation_name'";
     }
    
    unless (defined $relation_type)
     {
      log_warn "'$relation_name' not described in configuration; next relation";
      next;
     }
       
    my $retrieve = $relation_type -> retrieve_list ( $view ) ;
    
    
    my $result = {};

    debug "with '$view' view associated '$retrieve->[0]'";

    if ( $retrieve -> [0] eq 'record' )
     {
      ### XXX record now replaces 'template' in configuration.xml
      ### need to propagate this change throughout
      $result = $self -> get_record ( $relation_target ) ;
     }
    
    elsif ( $retrieve -> [0] eq 'nothing' )
     {
     
     }
    elsif ( $retrieve -> [0] eq 'ID' )
     {
      $result = $relation_target ;
     }
    else
     {
      my $referred_record = $self -> get_record ( $relation_target );
      
      foreach ( @$retrieve )
       {
        my $name_to_store = $_;
        
        # XXX
        
        unless (defined $referred_record)
         {
          log_error "can't get record '$relation_target'";
          $result = $relation_target;
          last;
         }
        
        my ( $spec, @values );
        
        if( /(.+):(.+)/ )
         {
          $name_to_store = $1;
          $spec = $2;
         }
        else
         {
          $spec = $_;
         }
        
        # XXX is this safe? : should be pretty safe
        
        $result -> {$name_to_store} = 
         [ $referred_record -> get_value( $spec ) ];
       }
     }
    
    if ( defined $result )
     {
      debug ("adding a relationship '$relation_name' -> '$result'");
      $record -> add_relationship ($relation_name, $result);
     }
   }
  
  debug "relations added";
  
  return $record;
}


1;

################################################################################

=pod

=head1 NAME

ARDB

=head1 SYNOPSIS

  use ARDB::Table;

  # ARDB::Table::Map:

<field-attribute-mapping map-name="documents">
	<field-associations
		title="title"
		subject="title,abstract,keywords"
		authors="author/name"
		authors_emails="author/email"
		keywords="keywords"
		abstract="abstract"
		creation_date="creation-date"
		handle="handle"
		special_field="My::ARDB::special_field_filter" />

</field-attribute-mapping>


perl code:


my $template = shift;

my $record = {};

$record->{title} = $template->{'title'}[0];
$record->{subject} = $template->{'title'}[0] .
			' '. $template->{'abstract'}[0] . 
			' '. $template->{'keywords'}[0] ;

$record->{author_emails} = ... $template->{author/email} ???;

$record->{special_field} = &My::ARDB::special_field_filter( $template );

return $record;




# ARDB::Table:

sub store_record {
  my $self       = shift;
  my $sql_helper = shift;
  my $record     = shift;


  ### issue an SQL statement 
  ### which will insert the record into the table...
  ### and return success status


}




=head1 DESCRIPTION

модуль имеет объектно-ориентированный интерфейс:

 this class works with ARDB subclasses, therefore it stores database name/login/pass,
 path to config file, ARDB::Config and sql_helper objects.


 methods:

   get_full_template ( $%template, $view )
   получает 2 параметра - template и view. текущий поддерживаемый формат template -
   хэш параметров - список значений - [ хэш параметров - список значений [ ... ] ]
   передается как ссылка на хэш. view определяет объем получаемой информации,
   определяется в L<ARDB::Configuration>. выдает full ( unfolded ) template.
   если view equal 'template', то 
                                 
   process_template ( $%template )   
                                 
   delete_template               
                                 
                                 
=head2 EXPORT

None by default.


=head1 AUTHOR

Ivan Baktcheev and Ivan Kurmanov

=head1 SEE ALSO

L<ARDB>, L<ARDB::Configuration>

=cut




# this will be a class

# objects of this class will own:
#
#  an ARDB::Configuration object
#  an sql_helper object

# methods to do:
#
#   get_full_template
#
#   put_template
#
#   delete_template
#
