# Copyright (c) 1999-2010 bivio Software, Inc.  All rights reserved.
#
# Visit http://www.bivio.biz for more info.
# 
# This library is free software; you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as
# published by the Free Software Foundation; either version 2.1 of the
# License, or (at your option) any later version.
# 
# This library is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
# 
# You should have received a copy of the GNU Lesser General Public
# License along with this library;  If not, you may get a copy from:
# http://www.opensource.org/licenses/lgpl-license.html
# 
# $Id: SingletonMap.pm,v 2.3 2010/09/08 21:40:01 nagler Exp $
package Bivio::Collection::SingletonMap;
use strict;
use Bivio::Base 'Bivio.UNIVERSAL';

# C<Bivio::Collection::SingletonMap> maps class names to singleton objects of
# those classes.  Singletons are initialized with a call to C<get_instance> or
# C<new> depending on which exists.
#
# This class needn't be subclassed but typically is.  If it is,
# the classes are stored in distinct spaces.  This would allow
# instantiating singletons in different ways in different
# contexts.  Subclasses of this module I<could> control how the
# singletons are instantiated.  Currently, there is only way
# to instantiate.

our($VERSION) = sprintf('%d.%02d', q$Revision: 2.3 $ =~ /\d+/g);
my(%_MAP);

sub get {
    my($proto, @classes) = @_;
    my($class) = ref($proto) || $proto;
    $_MAP{$class} = {} unless $_MAP{$class};
    my($map) = $_MAP{$class};
    b_die('must supply at least one class argument')
    unless @classes;
    my(@res);
    foreach my $x (@classes) {
	$proto->put($x)
	    unless exists($map->{$x});
	push(@res, $map->{$x});
    }
    return @res
	if wantarray;
    b_die('get not called in array context and more than one return result')
	unless int(@res) == 1;
    return $res[0];
}

sub put {
    my($proto, @classes) = @_;
    my($class) = ref($proto) || $proto;
    $_MAP{$class} = {}
	unless $_MAP{$class};
    my($map) = $_MAP{$class};
    my($c);
    foreach $c (@classes) {
	next if $map->{$c};
	my($res) = b_use($c);
#TODO: Remove caching?
	$map->{$c} = ref($res) ? $res
	    : $res->can('get_instance') ? $res->get_instance : $res->new;
    }
    return;
}

1;