package R::YapRI::Block;

use strict;
use warnings;
use autodie;

use Carp qw( carp croak cluck );
use Math::BigFloat;
use File::Spec;
use File::Temp qw( tempfile tempdir );
use File::Path qw( make_path remove_tree);
use File::stat;

use R::YapRI::Interpreter::Perl qw( r_var );


###############
### PERLDOC ###
###############

=head1 NAME

R::YapRI::Block.pm

A module to segment the R commands.

=cut

our $VERSION = '0.04';
$VERSION = eval $VERSION;

=head1 SYNOPSIS

  use R::YapRI::Base;

  ## WORKING WITH COMMAND BLOCKS:

  my $rbase = R::YapRI::Base->new();

  ## Create a file-block_1

  my $rblock1 = $rbase->create_block('BLOCK1');
  $rblock1->add_command('x <- c(10, 9, 8, 5)');
  $rblock1->add_command('z <- c(12, 8, 8, 4)');
  $rblock1->add_command('x + z')
  
  ## Get name or rbase

  my $blockname = $rblock1->get_blockname();
  my $rbase = $rblock1->get_rbase();  

  ## Create a file-block_2

  my $rblock2 = $rbase->create_block('BLOCK2');   
  $rblock2->add_command('bmp(filename="myfile.bmp", width=600, height=800)');
  $rblock2->add_command('dev.list()');
  $rblock2->add_command('plot(c(1, 5, 10), type = "l")');
  
  ## Run each block

  $rblock1->run_block();
  $rblock2->run_block();

  ## Get the results

  my $resultfile1 = $rblock1->get_resultfile();
  my $resultfile2 = $rblock2->get_resultfile();

  ## Combine block before run it

  my $newblock = $rbase->combine_blocks(['BLOCK1', 'BLOCK2'], 'NEWBLOCK');
  $newblock->run_block();



=head1 DESCRIPTION

A wrapper to use blocks with L<R::YapRI::Base>.

Use blocks through rbase object.

=head1 AUTHOR

Aureliano Bombarely <ab782@cornell.edu>


=head1 CLASS METHODS

The following class methods are implemented:

=cut 



############################
### GENERAL CONSTRUCTORS ###
############################

=head1 (*) CONSTRUCTORS:

There are two ways to create a new block:
 
1) Through rbase object.

my $rblock = $rbase->new_block($blockname);

2) Through R::YapRI::Block class

my $rblock = R::YapRI::Block->new($rbase, $blockname);

Both methods will add the new block to the rbase object.

=head2 constructor new

  Usage: my $rblock = R::YapRI::Block->new($rbase, $blockname);

  Desc: Create a new R block object associated with a R::YapRI::Base object

  Ret: a R::YapRI::Block object

  Args: $rbase, a R::YapRI::Base object.
        $blockname, an scalar, a blockname
        $cmdfile, a filename with the command file (optional).
        
  Side_Effects: Die if no arguments are used.
                Die if $rbase argument is not a R::YapRI::Base object.
                Create a new command file if no commandfile is supplied.
                Add the block created to rbase object.

  Example: my $rblock = R::YapRI::Block->new($rbase, 'MyBlock');           

=cut

sub new {
    my $class = shift;
    my $rbase = shift ||
	croak("ARG. ERROR: No rbase object was supplied to new() function.");
    my $blockname = shift ||
	croak("ARG. ERROR: No blockname was supplied to new() function.");
    
    my $cmdfile = shift;

    my $self = bless( {}, $class ); 

    ## Check variables.

    if (ref($rbase) ne 'R::YapRI::Base') {
	croak("ARG. ERROR: $rbase supplied to new() isnt a R::YapRI::Base obj");
    }

    ## Check if the block exists, if not 
    ## create a new block into the rbase object

    my $block = $rbase->get_blocks($blockname);
    
    unless (defined $block) {
	
	unless (defined $cmdfile) {
	    $cmdfile = $rbase->create_rfile();	    
	}

	$self->{rbase} = $rbase;
	$self->{blockname} = $blockname;
	$self->set_command_file($cmdfile);

	$rbase->add_block($self);
    }
    else {
	croak("ERROR: $blockname exists into the rbase object. Aborting new");
    }
    
    return $self;
}





#################
### ACCESSORS ###
#################

=head1 (*) ACCESSORS:

No set accessors have been created for rbase or blockname. 
They are controlled by R::YapRI::Base object.

=head2 get_rbase

  Usage: my $rbase = $rblock->get_rbase(); 

  Desc: Get rbase object from rblock

  Ret: $rbase, a R::YapRI::Base object

  Args: None

  Side_Effects: None

  Example: my $rbase = $rblock->get_rbase(); 

=cut

sub get_rbase {
    my $self = shift;
    return $self->{rbase};
}


=head2 get_blockname

  Usage: my $blockname = $rblock->get_blockname(); 

  Desc: Get blockname from rblock object

  Ret: $blockname, name of the block, an alias for cmdfile.

  Args: None

  Side_Effects: None

  Example: my $blockname = $rblock->get_blockname(); 

=cut

sub get_blockname {
    my $self = shift;
    return $self->{blockname};
}


=head2 get_command_file

  Usage: my $filename = $rblock->get_command_file(); 

  Desc: Get filename of the block from rbase object

  Ret: $filename, the command filename for the block associated to rbase.

  Args: None

  Side_Effects: None

  Example: my $filename = $rblock->get_command_file(); 

=cut

sub get_command_file {
    my $self = shift;
    return $self->{command_file};
}

=head2 set_command_file

  Usage: $rblock->set_command_file($filename); 

  Desc: Set filename for a block

  Ret: None

  Args: $filename

  Side_Effects: Die if no argument is used.

  Example: $rblock->set_command_file($filename); 

=cut

sub set_command_file {
    my $self = shift;
    my $filename = shift;
 
    unless (defined $filename) {
	croak("ERROR: No filename was supplied to set_command_file().");
    }
    else { 
	if (length($filename) > 0) {
	    unless (-f $filename) {
		croak("ERROR: command file $filename doesnt exist");
	    }
	}
    }

    $self->{command_file} = $filename;
}


=head2 delete_command_file

  Usage: $rblock->delete_command_file(); 

  Desc: Delete command filename for a block and set command file as empty

  Ret: None

  Args: None

  Side_Effects: None

  Example: $rblock->delete_command_file(); 

=cut

sub delete_command_file {
    my $self = shift;
    
    my $cmdfile = $self->get_command_file();

    if (defined $cmdfile && length($cmdfile) > 0) {
	if (-f $cmdfile) {
	    unlink($cmdfile); 
	}
    }
    $self->set_command_file('');
}



=head2 get_result_file

  Usage: my $filename = $rblock->get_result_file(); 

  Desc: Get result filename of the block

  Ret: $filename, the result filename for the block associated to rbase.

  Args: None

  Side_Effects: None

  Example: my $filename = $rblock->get_result_file(); 

=cut

sub get_result_file {
    my $self = shift;
    return $self->{result_file};
}

=head2 set_result_file

  Usage: $rblock->set_result_file($filename); 

  Desc: Set result filename for a block

  Ret: None

  Args: $filename, the result filename for the block associated to rbase.

  Side_Effects: Die if no argument is used or if the result file doesnt exist

  Example: $rblock->set_result_file($filename); 

=cut

sub set_result_file {
    my $self = shift;
    my $filename = shift;
    
    unless (defined $filename) {
	croak("ERROR: No filename was supplied to set_result_file().");
    }
    else { 
	if (length($filename) > 0) {
	    unless (-f $filename) {
		croak("ERROR: result file $filename doesnt exist");
	    }
	}
    }

    $self->{result_file} = $filename;
}


=head2 delete_result_file

  Usage: $rblock->delete_result_file(); 

  Desc: Delete result filename for a block and set command file as empty

  Ret: None

  Args: None

  Side_Effects: None

  Example: $rblock->delete_result_file(); 

=cut

sub delete_result_file {
    my $self = shift;
    
    my $resfile = $self->get_result_file();

    if (defined $resfile && length($resfile) > 0) {
	if (-f $resfile) {
	    unlink($resfile); 
	}
    }
    $self->set_result_file('');
}


#################
## CMD OPTIONS ##
#################

=head1 (*) COMMAND METHODS:

=head2 add_command

  Usage: $rblock->add_command($r_command); 

  Desc: Add a R command line to a block

  Ret: None

  Args: $r_command, a string or a hash ref. with the R commands.
        If hashref. is used, it will translated to R using r_var from
        R::YapRI::Interpreter::Perl

  Side_Effects: Die if no argument is used.
                Die if argument is not an scalar or an hash reference.
                Translate a perl hashref. to R command if hashref is used.

  Example: $rblock->add_command('x <- c(10, 9, 8, 5)')
           $rblock->add_command({ '' => { x => [10, 9, 8, 5] } })

=cut

sub add_command {
    my $self = shift;
    my $cmd = shift ||
	croak("ERROR: No arg. was used for add_command() function");

    my $rbase = $self->get_rbase();

    if (ref($cmd)) {
	if (ref($cmd) eq 'HASH') {
	    $rbase->add_command(r_var($cmd), $self->get_blockname());
	}
	else {
	    croak("ERROR: $cmd supplied to add_command() isnt scalar or href");
	}
    }
    else {
	$rbase->add_command($cmd, $self->get_blockname());
    }
}

=head2 read_commands

  Usage: my @commands = $rblock->read_commands(); 

  Desc: Read all the R command lines from a block and return them in an 
        array.

  Ret: @commands, an array with the commands used in the block

  Args: None

  Side_Effects: None

  Example: None

=cut

sub read_commands {
    my $self = shift;

    my $rbase = $self->get_rbase();
    my @cmds = $rbase->get_commands($self->get_blockname());
    
    return @cmds;
}


=head2 run_block

  Usage: $rblock->run_block(); 

  Desc: Run R commands for a specific block.

  Ret: None

  Args: None

  Side_Effects: None

  Example: $rblock->run_block(); 

=cut

sub run_block {
    my $self = shift;

    my $rbase = $self->get_rbase();
    $rbase->run_commands($self->get_blockname());
}


=head2 read_results

  Usage: my @results = $rblock->read_results(); 

  Desc: Read all the results lines from a block and return them as an 
        array.

  Ret: @results, an array with the produced by the block

  Args: None

  Side_Effects: None

  Example: my @results = $rblock->read_results();

=cut

sub read_results {
    my $self = shift;

    my @results;
    my $resultfile = $self->get_result_file();
    
    if (defined $resultfile) {
	open my $rfh, '<', $resultfile;
	while(<$rfh>) {
	    chomp($_);
	    push @results, $_;
	}
	close($rfh);
    }
    
    return @results;
}


################
## DESTRUCTOR ##
################

=head1 (*) DESTRUCTORS:

Destructor will delete the files associated with this block (command and
result) if the rbase switch keepfiles is disabled.

=head2 DESTROY

  Usage: $block->DESTROY(); 
 
  Desc: Destructor for block object. It also delete the command file and
        the result files associated with that block if keepfiles from
        rbase is disabled

  Ret: None

  Args: None

  Side_Effects: None

  Example: $block->DESTROY();

=cut

sub DESTROY {
    my $self = shift;
    my $rbase = $self->get_rbase();
    my $blockname = $self->get_blockname();

    ## Need to delete this blocks from rbase first.
    
    if (defined $blockname && defined $rbase) {
	delete($rbase->{blocks}->{$blockname});
    }
    
    unless (exists $rbase->{keepfiles} && $rbase->{keepfiles} == 1) {
	$self->delete_command_file();
	$self->delete_result_file();
    }
}


=head1 ACKNOWLEDGEMENTS

Lukas Mueller

Robert Buels

Naama Menda

Jonathan "Duke" Leto

=head1 COPYRIGHT AND LICENCE

Copyright 2011 Boyce Thompson Institute for Plant Research

Copyright 2011 Sol Genomics Network (solgenomics.net)

This program is free software; you can redistribute it and/or 
modify it under the same terms as Perl itself.

=cut

####
1; #
####