package RFC::Visitor;
#$Id: Visitor.pm,v 1.15 2016/06/13 12:10:42 sqko Exp $
#################################################################
#
#
#       RFC::Visitor
#
#
# The RFC::Visitor module defines the base behaviour for visitors
# used together with RFC::Rig and RFC::BaseDevice instances.
# The RFC::Visitor class is the base class, and the RFC::VisitorClear
# class isused to clear the internal references to already seen visitors
# 
# The DummyVisitor class can be used to test the Visitor pattern on
# a RFC::Rig instance (it merely count the number of devices).
#
# To obtain an instance call the constructors:
#
# my $v = RFC::VisitorClear->new();   - Clears the list of seen visitors
#
# my $v = RFC::TestVisitor->new();    - Tests the devices it is called on
#
# my $v = RFC::ConfigVisitor->new();    - Prints the device configuration.
#
# my $v = RFC::DebugVisitor->new($debuglevel);  - sets the debug level
#
# my $v = RFC::MeasuretimeVisitor->new();  - Gets the last time measurements were done for each device
#
# my $v = RFC::DummyVisitor->new();   - Runs through the devices and counts instances
#
# my $v = RFC::DisableProglogVisitor->new(); - Disables appending to proglog.
#
# my $v = RFC::EnableProglogVisitor->new(); - Enables appending to proglog if this is disabled.
#
# All RFC::Visitor derived classes must implement the follwoing
# member functions:
#
#
#  $id->VisitSimple($)   Must handle access to simple devices (such as 
#                        simplechannels)
#  $id->VisitComplex($)  Must handle access to complex devices (such as
#                        Temolog devices).
#  $id->result()         Return the calcualted value or string for the 
#                        visitor in question
#
# When designing new visitors it is advisable to make the visitor class name
# descriptive of what the visitor in question actually does.
#
#################################################################
use strict;
use warnings;
use Debug;
use RFC::Cache;
our @ISA = qw(Debug);

BEGIN {
    use Exporter ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION = 1.0;
    %EXPORT_TAGS = (
        'standard'=>[],
                    );
    Exporter::export_ok_tags('standard');
    Exporter::export_tags('standard');
    @ISA = qw(Exporter);
}

sub new
{
    my $class = shift;
    my $self = $class->SUPER::new();
    $self->{'_result'} = undef;
    bless $self,$class;
    return $self;
}

sub VisitSimple
{
    my $self = shift;
    my $dev = shift;
}

sub VisitComplex
{
    my $self = shift;
    my $dev = shift;
}

sub result
{
    my $self = shift;
    return $self->{'_result'};
}

package RFC::VisitorClear;
our @ISA = qw(RFC::Visitor);

sub new
{
    my $class = shift;
    my $self = $class->SUPER::new();
    bless $self,$class;
    return $self;
}

sub VisitSimple
{
    my $self = shift;
    my $dev = shift;
    $self->writedebug("Clearing visitor list for $dev") if ($self->debug);
    $dev->Clear_visitors();
}

sub VisitComplex
{
    my $self = shift;
    my $dev = shift;
    $self->writedebug("Clearing visitor list for $dev") if ($self->debug);
    $dev->Clear_visitors();
}

sub result
{
    my $self = shift;
    return 'Visitor lists cleared';
}


package RFC::DebugVisitor;
our @ISA = qw(RFC::Visitor);

sub new
{
    my $class = shift;
    my $level = 0;
    $level = shift if (@_);
    my $self = $class->SUPER::new();
    $self->{'_level'} = $level;
    bless $self,$class;
    return $self;
}

sub VisitSimple
{
    my $self = shift;
    my $dev = shift;
    $self->writedebug("Setting debug to ". $self->{'_level'}." for $dev") if ($self->debug);
    $dev->debug($self->{'_level'});
}

sub VisitComplex
{
    my $self = shift;
    my $dev = shift;
    $self->writedebug("Setting debug to ". $self->{'_level'}." for $dev") if ($self->debug);
    $dev->debug($self->{'_level'});
}

sub result
{
    my $self = shift;
    return $self->{'_level'};
}



package RFC::TestVisitor;
our @ISA = qw(RFC::Visitor);

sub new
{
    my $class = shift;
    my $self = $class->SUPER::new();
    bless $self,$class;
    $self->{'_cache'} = RFC::Cache->new();
    $self->{'_ok'} = 1;
    return $self;
}

sub VisitSimple
{
    my $self = shift;
    my $dev = shift;
    print "Testing simple $dev . . . ";
    unless( $dev->test($self->{'_cache'}))
    {
	$self->{'_ok'} = 0; 
	print "Not ok!\n";
    }
    else
    {
	print "Ok\n";
    }
}

sub VisitComplex
{
    my $self = shift;
    my $dev = shift;
    print "Testing complex $dev . . . ";
    unless( $dev->test($self->{'_cache'}))
    {
	$self->{'_ok'} = 0; 
	print "Not ok!\n";
    }
    else
    {
	print "Ok\n";
    }
}

sub result
{
    my $self = shift;
    return $self->{'_ok'};
}

package RFC::ConfigVisitor;
our @ISA = qw(RFC::Visitor);

sub new
{
    my $class = shift;
    my $self = $class->SUPER::new();
    $self->{'_list'} = [];
    bless $self,$class;
    return $self;
}

sub VisitSimple
{
    my $self = shift;
    my $dev = shift;
    $self->writedebug("Visiting simple device '$dev' for configuration") if ($self->debug);
    push @{$self->{'_list'}},$dev->type."\t".$dev->print_config();
}

sub VisitComplex
{
    my $self = shift;
    my $dev = shift;
    $self->writedebug("Visiting complex device '$dev' for configuration") if ($self->debug);
    push @{$self->{'_list'}},$dev->type."\t".$dev->print_config();
}

sub result
{
    my $self = shift;
    return reverse(@{$self->{'_list'}});
}


package RFC::MeasuretimeVisitor;
our @ISA = qw(RFC::Visitor);

sub new
{
    my $class = shift;
    my $self = $class->SUPER::new();
    $self->{'_list'} = [];
    bless $self,$class;
    return $self;
}

sub VisitSimple
{
    my $self = shift;
    my $dev = shift;
    $self->writedebug("Visiting simple device '$dev' for configuration") if ($self->debug);
    my $val = $dev->last_read;
    $val = '' unless (defined($val));
    push @{$self->{'_list'}},$dev->type.'-'.$dev->name.':'.$val
}

sub VisitComplex
{
    my $self = shift;
    my $dev = shift;
    $self->writedebug("Visiting complex device '$dev' for configuration") if ($self->debug);
    my $val = $dev->last_read;
    $val = '' unless (defined($val));
    push @{$self->{'_list'}},$dev->type.'-'.$dev->name.':'.$val;
}

sub result
{
    my $self = shift;
    return @{$self->{'_list'}};
}


package RFC::DummyVisitor;
our @ISA = qw(RFC::Visitor);

sub new
{
    my $class = shift;
    my $self = $class->SUPER::new();
    bless $self,$class;
    $self->{'_simple'} = 0;
    $self->{'_complex'} = 0;
    return $self;
}

sub VisitSimple
{
    my $self = shift;
    my $dev = shift;
    $self->writedebug("Visiting simple device '$dev'") if ($self->debug);
    $self->{'_simple'}++;
}

sub VisitComplex
{
    my $self = shift;
    my $dev = shift;
    $self->writedebug("Visiting complex device '$dev'") if ($self->debug);
    $self->{'_complex'}++;
}

sub result
{
    my $self = shift;
    my @arr = ();
    push @arr,'Simple devices:  '.$self->{'_simple'};
    push @arr,'Complex devices: '.$self->{'_complex'};
    push @arr,'Total devices:   '.($self->{'_simple'}+$self->{'_complex'});
    return @arr;
}


package RFC::DisableProglogVisitor;
our @ISA = qw(RFC::Visitor);

sub new
{
    my $class = shift;
    my $level = 0;
    my $self = $class->SUPER::new();
    $self->{'_simple'} = 0;
    $self->{'_complex'} = 0;
    bless $self,$class;
    return $self;
}

sub VisitSimple
{
    my $self = shift;
    my $dev = shift;
    $dev->disable_proglog(1);
    $self->writedebug("Disabling rig proglog for simple device $dev") if ($self->debug);
    $self->{'_simple'}++;
}

sub VisitComplex
{
    my $self = shift;
    my $dev = shift;
    $dev->disable_proglog(1);
    $self->writedebug("Disabling rig proglog for composite device $dev") if ($self->debug);
    $self->{'_complex'}++;
}


sub result
{
    my $self = shift;
    my $res = $self->{'_simple'} + $self->{'_complex'};
    $self->writedebug("A total of $res devices had rig proglog disabled") if ($self->debug);
    return $res;
}



package RFC::EnableProglogVisitor;
our @ISA = qw(RFC::Visitor);

sub new
{
    my $class = shift;
    my $level = 0;
    my $self = $class->SUPER::new();
    $self->{'_simple'} = 0;
    $self->{'_complex'} = 0;
    bless $self,$class;
    return $self;
}

sub VisitSimple
{
    my $self = shift;
    my $dev = shift;
    $dev->disable_proglog(0);
    $self->writedebug("Enabling rig proglog for simple device $dev") if ($self->debug);
    $self->{'_simple'}++;
}

sub VisitComplex
{
    my $self = shift;
    my $dev = shift;
    $dev->disable_proglog(0);
    $self->writedebug("Enabling rig proglog for composite device $dev") if ($self->debug);
    $self->{'_complex'}++;
}


sub result
{
    my $self = shift;
    my $res = $self->{'_simple'} + $self->{'_complex'};
    $self->writedebug("A total of $res devices had rig proglog enabled") if ($self->debug);
    return $res;
}


return 1;
