package RFC::Observer;
#$Id: Observer.pm,v 1.2 2016/06/13 12:14:10 sqko Exp $
##############################################################################
#
#
#      RFC::Observer
#
#
#  This module implements the observer pattern and defines the member functions
#  nescesarry for this.
#
#  To obtain a device instancee call the constructor:
#  my $id = RFC::Observer->new();
#
#
#
#  $id->attatch_observer($[$])  Attatches a new object to the list of observers.
#                               The first argument must be a reference to an object.
#                               The second (optional) argument can be a reference to a
#                               function to be called. In absence of this second
#                               argument, the default function to call is the observe()
#                               member function of the observer.
#                               If a custom function is specified it must accept at
#                               least 1 argument which is a string describing which
#                               action triggered the notify.
#                               Please note that only one reference to each object is
#                               allowed (the same device can not attatch itself to an
#                               other device more than once, any new invocations of
#                               attatch_observer to the same device will merely overide
#                               the notify function name). This makes sure that any notify
#                               of an object will only trigger once for each action trigger
#                               (for instance a call to setflow on a master device will
#                               only trigger one setflow command on each slave).
#                               Usually a slave can only be slaved to one device when the
#                               GUI is used, however it is possible to slave to more than
#                               one master device using attatch_obsever directly.
#  $id->list_observers()        Returns a list of observer devices (object references!)
#  $id->detatch_observer($)     Removes an object from the list of observers. The
#                               argument must be an object reference.
#  $id->notify($[@])            This function notifies all observers of the action
#                               in question (the first argument is a string describing
#                               the action triggering the notify), any additional
#                               arguments can be passed, however only the first is
#                               guarenteed to be passed to the observe functions.
#                               The function returns a list of response values / messages
#                               (if any) from the called functions.
#  $id->observe($[@])           Default function for callback in case of notification.
#                               This function is intended to be overridden in those
#                               cases where devices by design depends on the observer
#                               pattern. Corresponds the the Update() function according to GoF.
#
############################################################################################

use strict;
use warnings;
use Debug;
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();
    bless $self,$class;
    $self->{'_observers'} = [];
    return $self;
};

sub attatch_observer($)
{
    my $self = shift;
    my $ref = shift;
    $self->die("Argument to attatch_observer() is not a object reference") unless (ref($ref) eq 'REF');
    my $id = undef;
    for (my $x = 0; $x < @{$self->{'_observers'}}; $x++)
    {
        ### Check for multi assignment ###
        my $item = $self->{'_observers'}[$x]{'device'};
        $id = $x if ($ref && $$ref && $item && $$item && $$ref eq $$item);
    }
    if (defined($id))
    {
        if (@_)
        {
            $self->{'_observers'}[$id]{'func'} = shift;
        }
        else
        {
            $self->{'_observers'}[$id]{'func'} = 0;
        }
        return;
    }
    my %h = ('device' => $ref);
    if (@_)
    {
        $h{'func'} = shift;
    }
    else
    {
        $h{'func'} = 0;
    }
    push @{$self->{'_observers'}},\%h;
}

sub detatch_observer($)
{
    my $self = shift;
    my $ref = shift;
    $self->die("Argument to detatch_observer() is not a object reference") unless (ref($ref) eq 'REF');
    my $id = undef;
    for (my $x = 0; $x < @{$self->{'_observers'}}; $x++)
    {
        my $item = $self->{'_observers'}[$x]{'device'};
        $id = $x if ($ref && $$ref && $item && $$item && $$ref eq $$item);
    }
    return unless defined($id);
    my @list = ();
    for (my $x = 0; $x < @{$self->{'_observers'}}; $x++)
    {
        push @list,$self->{'_observers'}[$x] unless ($x == $id);
    }
    $self->{'_observers'} = \@list;
}


sub notify
{
    my $self = shift;
    my $action = shift;
    my $max = scalar(@{$self->{'_observers'}});
    my @response = ();
    for( my $x = 0; $x < $max; $x++)
    {
        my $d = $self->{'_observers'}[$x];
	if ($$d{'func'})
        {
            my $res = $$d{'func'}->($action,@_);
            push @response,$res if defined($res);
        }
        else
        {
            my $i = $$d{'device'};
            $self->writedebug("Device '".$self->name."' of type '". $self->type."' Called notify()") if ($self->debug > 1);
            my $res = $$i->observe($action,@_);
            push @response,$res if defined($res);
        }
    }
    return @response;
}

sub list_observers
{
    my $self = shift;
    my @list = ();
    my $max = scalar(@{$self->{'_observers'}});
    for( my $x = 0; $x < $max; $x++)
    {
        my $d = $self->{'_observers'}[$x];
        my $i = $$d{'device'};
        push @list,$i;
    }
    return @list;
}

sub observe
{
    my $self = shift;
    my $action = shift;
    ### Stub method, to be overridden when actually using observer pattern ###
    $self->writedebug("Warning, Observe called for an object '".$self->name."' for which observe was not overloaded!");
    return undef;
}

return 1;
