package APE::InputControllerFactory::ConcreteInputController::STUDY_InputController;

use base 'APE::InputControllerFactory::ConcreteInputController::DefaultExoApeInputController';

$APE::InputControllerFactory::ConcreteInputController::STUDY_InputController::VERSION = '1.1';

use strict;
use warnings;
use Carp;

use APE::InputControllerFactory::ConcreteInputController::Requirement;

=head1 NAME

APE::InputControllerFactory::ConcreteInputController::STUDY_InputController

=cut

use constant LOGIN => 'snp';
use constant TRUE  => 1;
use constant FALSE => 0;

{
    my %_attributes = (
        ## ** Add your object attributes here **
        ## They will automatically be given a get method.
        ## e.g. attribute 'personForename' can be accessed
        ## using getPersonForname(). There are no automatic
        ## set routines, they must be declared or the attribute
        ## value must be parsed in the constructor
        ## i.e new InputController(personForename=>'Simon');
      );

    my %object;

    foreach my $attName ( keys(%_attributes) ) {
        no strict 'refs';
        *{ __PACKAGE__ . "::get\u$attName" } =
          sub { $object{ $_[0] }->{$attName} }
    }

    #################################################################
    ## Initialise the objects private attributes. The argument is
    ## deleted as it is found, initialised and set.
    #################################################################
    sub _init {
        my ( $self, %args ) = @_;
        foreach my $attName ( keys(%args) ) {
            if ( exists( $_attributes{$attName} ) ) {
                $object{$self}->{$attName} = delete $args{$attName};
            }
        }

        ## Set the description as this is a specialised InputController.
        $args{description} =
          "An InputController that requests a study name BEFORE requesting any "
          . "default requirements."
          unless $args{description};

        return $self->SUPER::_init(%args);
    }

    #################################################################
    ## Overridden method from InputController base class.
    #################################################################
    sub createRequirements {
        my $self = shift;
        return if $self->hasRequirements;
        ## Call the super classes createRequirements method to get the
        ## basic requirements.
        $self->SUPER::createRequirements;
        ## Create a new container for the PC Study Requirement object.
	$self->addStudyRequirement();
    }


=item $inputController->addStudyRequirement()

Adds a Requirement requesting the user to select a study from a drop
downlist populated from the database.

=cut

    sub addStudyRequirement {
        my $self = shift;
        ## Create a new container for the PC Study Requirement object.
        my $studyRc = new
          APE::InputControllerFactory::ConcreteInputController::RequirementContainer(
            outDescription => 'Study Name' );
        ## Add the study input Requirement object to the new RequirementContainer.
        $studyRc->pushRequirement( $self->_getStudyRequirement );
        ## Add the populated RequirementContainer to the global container list.
        $self->unshiftRequirementContainer($studyRc);
    }

    #################################################################
    ## Method to add an Input Requirement object that requests the study
    ## name from the user to the top of the requirementList object
    ## attribute.
    #################################################################
    sub _getStudyRequirement {
        my $self = shift;
        ## Get a hash of the available study names and their ids.
        my $studyName     = $self->_getStudyName;
        my $studyNameList = $studyName->[0];
        my $studyNameHash = $studyName->[1];
        ## New Requirement requesting the study name.
        return (
            new
              APE::InputControllerFactory::ConcreteInputController::Requirement(
                id           => 'STUDY',
                type         => 'Input',
                default      => 'ExoSeq',
                description  => 'Select Study name [def:exoseq]: ',
                options      => $studyNameList,
                checkingCode => sub {
                    my ( $self, $data ) = @_;
                    $data = uc($data);
                    if ( exists( $studyNameHash->{$data} ) ) {
                        $self->setData( $studyNameHash->{$data}, 1 );
                    }
                    else {
                        croak
                          "ERROR: study with name '$data' is not recognised.";
                    }
                  }
              )
          );
    }

    #################################################################
    ## Overridden method from InputController base class.
    ## Processes a Requirment object from the requirementObjectList
    ## built by the createRequirements method.
    #################################################################
    sub process {
        my ( $self, $requirementObj ) = @_;
        ## Set the data for this Requirement object. If the
        ## Requirement object is the study then set that and make sure
        ## every other Requirement knows about it.
        $requirementObj = $self->_setData($requirementObj);
    }

    #################################################################
    ## Method to set the data required by a Requirement object. This
    ## method assumes that the first Input type Requirement contains
    ## the study id and sets it. Non Input type Requirements are dealt
    ## with in the standard way except that setData is passed an array
    ## ref containing the usual data and the study id.
    #################################################################
    sub _setData {
        my ( $self, $requirementObj ) = @_;
        ## Set the id_study if this is the input Requirement object.
        if (   $requirementObj->getType() eq 'Input'
            && $requirementObj->getId eq 'STUDY' )
        {
            $object{$self}->{idStudy} = $requirementObj->getData;
            warn "\n*** Using id_study: $object{ $self }->{idStudy} ***\n\n";
        }

        ## Populate Requirement objects with lookup data based on
        ## their type and id.
        unless ( $requirementObj->getType eq 'Input' ) {
            $requirementObj = eval { $self->getData($requirementObj); };
            if ($@) { croak $@; }
            my $data = $requirementObj->getData;
            $requirementObj->setData( [ $data, \$object{$self}->{idStudy} ],
                1 );
        }

        return $requirementObj;
    }

    #################################################################
    ## Method to return a list and a hash of all the available studies
    ## from the db.  Hash lookups can be made with either the
    ## study.description or the study.id_study.  They each return the
    ## other as their values.
    #################################################################
    sub _getStudyName {
        my $self          = shift;
        my %studyNameHash = ();
        my @studyNameList = ();
        my $studyData     = eval {
            $self->getSqlEngineObj->getAll(
                'APE/InputControllerFactory/ConcreteInputController/STUDY_InputController::StudyName_lookup',
                [], SqlEngine2::getDbh(LOGIN)
              );
          };
        if ($@) { croak "ERROR: can't get study names from the database: $@" }
        if ( defined $studyData && scalar( @{$studyData} ) != 0 ) {
            foreach ( @{$studyData} ) {
                my $studyName = uc( $_->[0] );
                my $idStudy   = $_->[1];
                $studyNameHash{$studyName} = $idStudy;
                $studyNameHash{$idStudy}   = $idStudy;
                push ( @studyNameList, $studyName );
            }
        }
        return [ \@studyNameList, \%studyNameHash ];
    }

    #################################################################
    ## Method to destroy this object.
    #################################################################
    sub DESTROY {
        my $self = shift;
        delete $object{$self};
        $self->SUPER::DESTROY;
    }
}

1;
