Initial commit of MooseX::Singleton and MooseX::Service

diff --git a/Build.PL b/Build.PL
new file mode 100644 (file)
index 0000000..400e632
--- /dev/null
+++ b/Build.PL
@@ -0,0 +1,19 @@
+#!/usr/bin/env perl
+
+use Module::Build;
+
+use strict;
+use warnings;
+
+Module::Build->new (
+  module_name => 'MooseX::Singleton',
+  license => 'perl',
+  requires => {
+    'Moose' => '0.20',
+  },
+  build_requires => {
+    'Test::More' => '0.70',
+    'Test::Exception' => '0.25',
+  },
+)->create_build_script;
+

diff --git a/lib/MooseX/Singleton.pm b/lib/MooseX/Singleton.pm
new file mode 100644 (file)
index 0000000..38f22ec
--- /dev/null
+++ b/lib/MooseX/Singleton.pm
@@ -0,0 +1,28 @@
+package MooseX::Singleton;
+
+use Moose::Role;
+
+our $VERSION = 0.01;
+
+override new => sub {
+  my ($class) = @_;
+
+  no strict qw/refs/;
+
+  my $instance = super;
+
+  ${"$class\::singleton"} = $instance;
+
+  return $instance;
+};
+
+sub instance {
+  my ($class) = @_;
+
+  no strict qw/refs/;
+
+  return ${"$class\::singleton"};
+}
+
+1;
+

diff --git a/t/singleton.t b/t/singleton.t
new file mode 100644 (file)
index 0000000..de4eab6
--- /dev/null
+++ b/t/singleton.t
@@ -0,0 +1,25 @@
+use Test::More tests => 2;
+
+use strict;
+use warnings;
+
+{
+  package Foo::Singleton;
+
+  use Moose;
+
+  has gravy => (is => 'rw');
+
+  with qw/MooseX::Singleton/;
+}
+
+ok (Foo::Singleton->new,'new');
+
+my $foo = Foo::Singleton->instance;
+
+my $bar = Foo::Singleton->instance;
+
+$foo->gravy ('sauce');
+
+is ($bar->gravy,'sauce','singleton');
+