Singleton implementation on perl6

Question

I looked at the following code on Rosetta code http://rosettacode.org/wiki/Singleton#Perl_6 which implements Singleton in Perl6

class Singleton {

    has Int $.x is rw;
    # We create a lexical variable in the class block that holds our single instance.
    my Singleton $instance = Singleton.bless; # You can add initialization arguments here.
    method new {!!!} # Singleton.new dies.
    method instance { $instance; }
}

my $a=Singleton.bless(x => 1);
my $b=Singleton.bless(x=> 2);


say $a.x;
say $b.x;

#result 
# 1
# 2

but it seems using this implementation i can create tow instances of the same class using bless see example above ,

is there an option to prevent the implemention to only one instance of the same class ?

Answer 1

Perl prides itself on providing many ways to do things leaving you to pick the one that suits your tastes and the application at hand. I say that to highlight that this is one simple but solid, hopefully self-explanatory way - I'm not putting it forward as "the best" because that depends on your circumstances.

#!/usr/bin/env perl6

class Scoreboard {
  has Str $.home-team ;
  has Str $.away-team ;
  has Int $.home-score = 0 ;
  has Int $.away-score = 0 ;
  my Scoreboard $instance;

  method new(*%named) {
      return $instance //= self.bless(|%named) ;
  }

  multi method goal($team where * eq $!home-team,  Int :$points = 6) {
      $!home-score += $points
  }

  multi method goal($team where * eq $!away-team,  Int :$points = 6) {
      $!away-score += $points
  }

  method Str {
      "At this vital stage of the game " ~

      do given $!home-score <=> $!away-score {
          when More {
              "$!home-team are leading $!away-team, $!home-score points to $!away-score"
          }
          when Less {
              "$!home-team are behind $!away-team, $!home-score points to $!away-score"
          }
          default {
              "the scores are level!  $!home-score apeice!"
          }
      }
  }
}

my $home-team = "The Rabid Rabbits";
my $away-team = "The Turquoise Turtles";  # Go them turtles!

my $scoreboard = Scoreboard.new( :$home-team , :$away-team );

$scoreboard.goal($home-team, :4points) ;
say "$scoreboard";
$scoreboard.goal($away-team) ;
say "$scoreboard";
my $evil_second_scoreboard = Scoreboard.new;
$evil_second_scoreboard.goal($home-team, :2points) ;
say "$evil_second_scoreboard";

This produces;

At this vital stage of the game The Rabid Rabbits are leading The Turquoise Turtles, 4 points to 0
At this vital stage of the game The Rabid Rabbits are behind The Turquoise Turtles, 4 points to 6
At this vital stage of the game the scores are level!  6 apeice!

This overrides the default new (normally supplied by class Mu) and keep a reference to ourself (ie this object) in private class data. For private class data, we use a lexically scoped scalar declared with my. The // is the operator form of .defined. So, on the first run, we call bless which allocates the object and initialize the attributes, and then assign it to $instance. In subsequent calls to new, $instance is defined and is immediately returned.

If you want to prevent someone calling bless directly, you can add;

method bless(|) {
    nextsame unless $instance;
    fail "bless called on singleton Scoreboard"
}

which will ensure that only the first call will work.