package Ace_Record;
#
#
#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################
#
# Author: pjm (Paul mooney)
#
# Some if this code maybe a little scary since an Ace_Record can have child
# records so $parent->create_data() may call $child->create_data().
#
# This idea is this: an Ace_Record object is given SQL, an ACE definition
# and maybe a WHERE clause. The SQL is prepared once and executed 1 or more
# times. The data is put into $self->{datastore} . If there is a WHERE
# clause it will eval{} it. The datastore is made "visble" by variable
# $REF_TO_ARRAY. This is so the array of arrays can be modified by Perl
# code for those "special cases" where Oracle data does no map directly
# onto ace data. Finally the ACE defination is used to output the data
# from the rows in the datastore.
#
# A parent may have child records. For each row in the parents datastore
# the child record is called to create_data(). A parent can have more
# than 1 child. A child can have a child but I haven't tested that...
#
# $Id: Ace_Record.pm,v 1.1 2000/11/08 11:51:32 pjm Exp $
#

use strict;
use Data::Dumper;

my $debug    = 0;
my $PRINT_ME = 0; # Used for "specail" debugging, to be removed...


sub new {
    my ($type, $name) = @_;

    my $self = {
        name        => $name,
        sub_records => undef,
    };
    bless $self, $type;

    return $self;
}

#sub output_once {
#    my ($self) = @_;
#    $self->{output_once} = 1;
#}

sub add_sql {
    my ($self, $sql) = @_;

    $self->{sql}     = $sql;
}

sub add_where {
    my ($self, $where) = @_;
    $self->{where}     = $where;
}

sub add_ace {
    my ($self, $ace_record_defintion) = @_;

    $self->{ace_record_def} = $ace_record_defintion;
}

sub print_all {
    my ($self) = @_;

    print "Record: ", $self->{name}, "\n";
    print "sql\n---\n",     $self->{sql}, "\n";
    print "where\n-----\n ", $self->{where}, "\n";
    print "ace\n---\n",      $self->{ace_record_def}, "\n\n";

}

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

sub add_sub_record {
    my ($self, $ace_record) = @_;

    print "add_sub_record: adding ", $ace_record->{name}, "\n" if $debug;

    push @{$self->{sub_records}}, $ace_record;
}

sub create_data {
    my ($self, $dbh, $parent_name, @VAR) = @_;

    # prepare, execute. prepare only 1st time though
    $self->fetch_all_from_db($dbh, $parent_name, @VAR);
    $self->run_where();

#    if( $self->already_created() ){
#        return;
#    }

    if( 0 ){
        if( $self->{name} eq 'Status_info' && $VAR[0] eq 'bA563A22' ){
            print "create_data: $parent_name, ",
                join(', ', @VAR), "\ndatastore = ",
                Data::Dumper::Dumper($self->{datastore});
            
            $PRINT_ME = 1;
        }
        else {
            $PRINT_ME = 0;
        }
    }

    # Do we have sub records?
    if( defined $self->{sub_records} && @{$self->{sub_records}} ){

        # feed each line into the sub record
        foreach my $row_ref (@{$self->{datastore}}){

            $self->output_row($row_ref); # show details for this record

            if( $debug ){
                print "Getting sub records for $self->{name} : Num Recs ",
                    scalar(@{$self->{datastore}}), " : values ",
                    join(', ', @{$row_ref}), "\n";
            }

            foreach my $sub_record (@{$self->{sub_records}}){
                if( $debug ){
                    print "Calling $sub_record->{name} with : ",
                        join(', ', @{$row_ref}), "\n";
                }

                $sub_record->create_data($dbh, $self->{name}, @{$row_ref});
            }
        }
    }
    else {
        # write out all rows in one go
        $self->append_to_ace_file();
    }
}

################################################################################
# Database routines
################################################################################

sub fetch_all_from_db {
    my ($self, $dbh, $parent_name, @VAR) = @_;

    $self->prepare_sql($dbh, $parent_name);
    $self->execute_sql(@VAR);
    $self->finish();
}

# Will be passed in the name of the parent record so we can parse out
#    parent.VAR[1] etc...
#
sub prepare_sql {
    my ($self, $dbh, $parent_name) = @_;
    my (@new_sql, @indexes);

    # if this is a sub record & we haven't already prepared the SQL...
    if( $parent_name && (! $self->{sth}) ){
 
        print "parent name: $parent_name\n" if $debug;

        foreach my $line ( split("\n", $self->{sql}) ){
            $line =~ s/^(\s*)//; # no spaces

#            print "BEFORE: $line", "\n";

            my ($index) = ($line =~ /$parent_name\.\$VAR\[(\d)\]/);

            if( defined $index ){
                push @indexes, $index;
                print "\n\n!!! index = $index, ",
                    Data::Dumper::Dumper(\@indexes),"\n\n\n" if $debug;
            }

            # replace 'Parent.$VAR[1]' with ?. I have to use '$v' because
            # it is normall a quote symbol in a reg ex and I can't seem to
            # escape it.
            my $v = '?';
            $line =~ s/('$parent_name\.\$VAR\[\d+\]')/$v/ge;
                
#            print "AFTER:  $line", "\n";

            push @new_sql, $line;
        }

#        print "SQL = $self->{sql}\n";
    }

    if( @new_sql ){
        $self->{sth} = $dbh->prepare(join(' ', @new_sql));
        $self->{bind_order} = \@indexes;

        print "\n\nBIND ORDER NOW EQUALS: @{$self->{bind_order}}\n\n" if $debug;
    }
    else {
        unless ( $self->{sth} ){
            $self->{sth} = $dbh->prepare($self->{sql});
        }
    }
}

sub execute_sql {
    my ($self, @VAR) = @_;
    my @selected_vars;

#    if( 0 ){
#        print "caller = ", join(', ', caller()), "\n";
#
#        my ($pack, $file, $line, $subname, $hashargs, $wantarray);
#        my $i = 0;
#        while(($pack, $file, $line,
#               $subname, $hashargs, $wantarray) = caller($i++)){
#            print "$pack, $file, $line, $subname, $hashargs, $wantarray\n";
#        }
#    }

    if( defined $self->{bind_order} ){
        foreach my $index (@{$self->{bind_order}}){
            push @selected_vars, $VAR[$index];
        }
    }

    $self->{sth}->execute(@selected_vars);
    $self->{datastore} = $self->{sth}->fetchall_arrayref();
}

sub finish {
    my ($self) = @_;

    $self->{sth}->finish();
}

################################################################################
# Perl routines
################################################################################

sub run_where {
    my ($self) = @_;

    my $REF_TO_ARRAY = $self->{datastore};

    eval $self->{where};

    if( $@ ){
        die "Error executing 'where' statement for record $self->{name}\n$@";
    }
}

# if th


#
#
# HERE HERE
#
#

#sub already_created {
    my ($self) = @_;

#    my $compressed = Dumper($self->{datastore});

#    print "compressed;\n";
#    print "$compressed\n";

#    if( defined $self->{previous_data} ){
#        foreach my $saved_data (@{$self->{previous_data}}){
#            if( $saved_data eq $compressed ){
#                return 1;
#            }
#        }

        # if got to here have not returned so not in saved data

#        push @{$self->{previous_data}}, $compressed;
#    }
#    else {
#        push @{$self->{previous_data}}, $compressed;
#    }

#    return 0;
#}


################################################################################
# Output ACE record routines
################################################################################

# No sub records so this sub gets called to dump all of the datastore
#
sub append_to_ace_file {
    my ($self) = @_;

    if( defined $self->{datastore} && @{$self->{datastore}} ){
        my $total_num_rows = @{$self->{datastore}};

        foreach my $row_ref (@{$self->{datastore}}){

            my $return_val = $self->output_row($row_ref, $total_num_rows);

            last if $return_val == 2;
        }
    }
}

# This routines actually spits out the data to the file.
# It is called by append_to_ace_file() above and create_data() just before
# it 'runs' the sub records.
#
# This is where the data is substituted with the $VAR1 stuff
#
# Returns;
#
#    2 : do not execute any more rows!!!
#
sub output_row {
    my ($self, $row_ref, $TOTAL_NUM_ROWS) = @_;

    my @VAR              = @{$row_ref};
    my $ignore_next_line = 0;
    my $last_line        = 0;
    my $no_line_space    = 0;

    if( defined $self->{ace_record_def} ){
        # print "$self->{name}\n";

#if( $PRINT_ME ){
#    print "output_row: , ", join(', ', @{$row_ref}), "\n";
#}

        foreach my $line ( split("\n", $self->{ace_record_def}) ){
            $line =~ s/^\s*//; # no leading spaces

            if( $ignore_next_line ){
                $ignore_next_line = 0;
                next;
            }

            my ($no_var, @indexes);
            my $line_has_values = 0;

            # scope $1 so we don't get any other reg ex value
            {
                unless( $line =~ /\$VAR\[\d+\]/ ){
                    $no_var = 1;
                }
                else {
                    (@indexes) = ($line  =~  /\$VAR\[(\d+)\]/g);
                    $line      =~ s/\$VAR\[(\d+)\]/$VAR[$1]/ge;

                    foreach my $index (@indexes){

                        #if( $PRINT_ME ){
                        #    print "Index = $index, value = $VAR[$index], ", join(', ', @indexes),"\n";
                        #}
                        # took out '&& $VAR[$index]' cos it won't like zero '0'
                        # or ' '
                        if( defined $VAR[$index] ){
                            $line_has_values = 1;
                            last;
                        }
                    }
                }
            }

            my $evaluated = 1;
            my $next      = 0;
            my $last      = 0;

            if( $line =~ /\s+IF_CONDITION (.*)$/ ){
                # After Value/Tag
                $evaluated  = eval $1;
                $line =~ s/IF_CONDITION (.*)$//;
            }
            elsif( $line =~ /IF_CONDITION\((.*)\)$/ ){
                # Lines starts with IF_CONDITION
                $evaluated  = eval $1;

                if( $evaluated ){ $last_line        = 1; }
                else            { $ignore_next_line = 1; }

                $next = 1;
            }
            elsif( $line =~ /^NO_LINE_SPACE/ ){
                # No blank line after this record
                $no_line_space = 1;
                $next          = 1;
            }
            elsif( $line =~ /^LINE_SPACE/ ){
                # blank line after this record
                print "\n";
                $next = 1;
            }
            elsif( $line =~ /NO_LINE_SPACE/ ){
                # no blank line after this record
                $line =~ s/NO_LINE_SPACE//;
                $no_line_space = 1;
            }

            if( $line =~ /FIRST_RECORD/ ){
                return 2;
            }

            last if $last;
            next if $next;

            # Finally print stuff out (if IF_CONDITION is true!)
            if( $evaluated ){
                if( @indexes && $line_has_values ){
                    $line = $self->maybe_strip_last_var($line);

                    print "$line\n";
                }
                # else if no $VAR[\d] on the line at all!!!
                elsif( $no_var ){
                    print "$line\n";
                }
            }

            if( $last_line ){
                print "\n" unless $no_line_space;
                return 2;
            }
        }

        print "\n" unless $no_line_space;
    }
}

# If the line = Something "$VAR[1]" $VAR[2]" and this interpolates to
#               Something "123" ""
# then this will make it
#               Something "123"
#
sub maybe_strip_last_var {
    my ($self, $line) = @_;

#    print STDERR "BEFORE: $line\n";

    # if "" at end of line
    $line =~ s/\"\"\s*$//;

#    print STDERR "AFTER:  $line\n";


    return $line;
}


1;

#
# $Log: Ace_Record.pm,v $
# Revision 1.1  2000/11/08  11:51:32  pjm
# Initial revision
#
#
