The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
 / 
Syringe
River stage zero No dependents
++
/ Syringe

NAME

Syringe

SYNOPSIS

    use strict;
    use warnings;

    use Syringe;

    my $container = Syringe->instance( path => $path_to_yaml_config );

    # get an object that is fully instantiated with all dependencies WITHOUT having
    # to have 'use' dependecies in the class files themselves. 
    my $object = $container->get_service("SomeUniqueIdentifier");

    $object->do_stuff();

DESCRIPTION

Syringe is a lightweight implementation of a Dependency Injection Container with built in Log::Log4perl logging. This implementation uses constructor injection and also implements a registry via the get_service method.

YAML CONFIG FILE

Syringe takes a simple YAML file for configuration. The format is:

    ServiceName:
      class:
        name: "Service::Class::Foo"
      dependencies:
        param1:
          value: value1
        param2:
          value: value2
        param3:
          service: AServiceIdentifier
    AServiceIdentifier:
      class:
        name: "Service::Class::Bar"
      dependencies:
        somenumber:
          value: 1000 
        somestring:
          value: "This is a string"

In the example snippet above, "ServiceName" is a unique identifier string of a "service". A "service" in this context is an instantiated object at runtime.

The depenedencies section lists all the arguments that have to be passed to the object inorder to instantiate it. It is assumed that parameters are being passed to the constructer in hash format. And it is assumed that the constructor method is 'new'. If it is not, you should write a facade class around the one you want to instantiate.

Services can list other services at dependencies by using the 'service:' identifier like so:

        param3:
          service: AServiceIdentifier

The container will format a hash to pass to the constructor of the service like so:

    Service::Class::Foo->new(
            param1 => "value1",
            param2 => "value2",
            param3 => $AServiceIdentifierObj
    );

Where $AServiceIdentifierObj is an instance of the AServiceIdentifier service class.

EXAMPLE CLASSES

In this example, we define classes and interfaces (Roles in Moose) to model cars, engines, transmissions and transmission interface (how to shift). In the EXAMPLE YAML CONFIGURATION section below, we will be taking this and 'wiring' our runtime objects together by declaring relationships and dependencies in the YAML file. Any dependencies will be "injected" into the appropriate objects that depend on them.

    use MooseX::Declare;

    class RA::UnitTest::6SpeedShifter with RA::UnitTest::ShifterInterface {
        has 'pattern' => (
            isa      => 'Str',
            is       => 'ro',
            required => 1,
        );

        method up_shift {
            return 1;
        }

        method down_shift {
            return 1;
        }

        method reverse_shift {
            return 1;
        }

        method put_in_neutral {
            return 1;
        }
    }

    class RA::UnitTest::Car with RA::UnitTest::CarInterface {
        has 'been_raced_on_track' => (
            isa      => 'Bool',
            is       => 'ro',
            required => 1,
            default  => 0,
        );

        method warranty {
            if ($self->been_raced_on_track) {
                return "I'm sorry, you're warranty is void.";
            }
            else {
                return "I'm sorry, most likely you're warranty is void anyways.";
            }
        }
    }

    role RA::UnitTest::CarInterface {
        has 'make'   => (
            isa      => 'Str',
            is       => 'ro',
            required => 1
        );

        has 'model'   => (
            isa      => 'Str',
            is       => 'ro',
            required => 1
        );

        has 'year'   => (
            isa      => 'Int',
            is       => 'ro',
            required => 1
        );

        has 'engine'   => (
            does     => 'RA::UnitTest::EngineInterface',
            is       => 'ro',
            required => 1
        );

        has 'transmission'   => (
            does     => 'RA::UnitTest::TransmissionInterface',
            is       => 'ro',
            required => 1
        );

        method start_engine {
            $self->engine->start;
        }

        method stop_engine {
            $self->engine->stop;
        }
    }

    class RA::UnitTest::Engine with RA::UnitTest::EngineInterface {
        method start_sound {
            print "Kchhh vroooooOOOOMmmm..\n";
        }

        method stop_sound {
            print "Bupp bupp";
        }

        method idle_sound {
            print "Bup bup baa bup bup baa bup bup baa bup bup baa.\n";
        }

        method catastrophic_failure_sound {
            print "KAAAAA BOOOOOOOOOOOOOOOOOOOOOOOOMMMMMMMMM!!!!!!\n";
        }
    }

    role RA::UnitTest::EngineInterface {
        requires qw(
            start_sound
            stop_sound
            idle_sound
            catastrophic_failure_sound
        );

        has 'make'   => (
            isa      => 'Str',
            is       => 'ro',
            required => 1
        );

        has 'model'   => (
            isa      => 'Str',
            is       => 'ro',
            required => 1
        );

        has 'year'   => (
            isa      => 'Int',
            is       => 'ro',
            required => 1
        );

        has 'displacement'   => (
            isa      => 'Int',
            is       => 'ro',
            required => 1
        );

        has 'cylinders'   => (
            isa      => 'Int',
            is       => 'ro',
            required => 1
        );

        has 'horsepower'   => (
            isa      => 'Int',
            is       => 'ro',
            required => 1
        );

        method start {
            $self->start_sound();
            return 1;
        }

        method idle {
            $self->idle_sound();
            return 1;
        }

        method stop {
            $self->stop_sound();
            return 1;
        }

        method catastrophic_failure {
            $self->catastrophic_failure_sound();
            return 1;
        }
    }

    role RA::UnitTest::ShifterInterface {
        requires qw(up_shift down_shift reverse_shift put_in_neutral);
    }


    class RA::UnitTest::Transmission with RA::UnitTest::TransmissionInterface {

    }

    role RA::UnitTest::TransmissionInterface {
        has 'make'   => (
            isa      => 'Str',
            is       => 'ro',
            required => 1
        );

        has 'model'   => (
            isa      => 'Str',
            is       => 'ro',
            required => 1
        );

        has 'interface'   => (
            does     => 'RA::UnitTest::ShifterInterface',
            is       => 'ro',
            required => 1
        );

        has 'current_gear'   => (
            isa      => 'Int',
            is       => 'rw',
            required => 1,
            default  => 0, # neutral
        );

        has 'forward_gears'   => (
            isa      => 'Int',
            is       => 'ro',
            required => 1,
        );

        has 'reverse_gears'   => (
            isa      => 'Int',
            is       => 'ro',
            required => 1,
        );

        method upshift {
            if ($self->current_gear == $self->forward_gears) {
                return;
            }
            else {
                $self->current_gear($self->current_gear + 1);
            }
        }

        method downshift {
            if ($self->current_gear < 1) {
                return;
            }
            else {
                $self->current_gear($self->current_gear - 1);
            }
        }

        method put_in_neutral {
            $self->current_gear(0);
        }

        method put_in_reverse {
            if ($self->current_gear < 1) {
                $self->current_gear(-1);
            } else {
                print "CRUNCHHHH!\n";
            }
        }
    }

EXAMPLE YAML CONFIGURATION

Here is the example YAML configuration that refers to the classes we defined in the section above. We define two cars here. One is a factory 2007 Chevrolet Z06 (StockCar) and one is a heavily modified Z06 (FastNFuriousCar).

    StockCar:
      class:
        name: "RA::UnitTest::Car"
      dependencies:
        make:
          value: "Chevrolet"
        model:
          value: "Z06"
        year:
          value: 2007
        engine:
          service: "LS7Engine"
        transmission:
          service: "TremecT56Transmission"
    FastNFuriousCar:
      class:
        name: "RA::UnitTest::Car"
      dependencies:
        make:
          value: "VIN BENZINE"
        model:
          value: "Z006"
        year:
          value: 2012
        engine:
          service: "RidiculouslyModdedLS7Engine"
        transmission:
          service: "TremecT56Transmission"
    LS7Engine:
      class:
        name: "RA::UnitTest::Engine"
      dependencies:
        make:
          value: "GM"
        year:
          value: "2007"
        model:
          value: "LS7"
        displacement:
          value: 7000
        cylinders: 
          value: 8
        horsepower:
          value: 505
    TremecT56Transmission:
      class: 
        name: "RA::UnitTest::Transmission"
      dependencies:
        make:
          value: "Tremec"
        model:
          value: "T56"
        interface:
          service: "Standard6SpeedHPattern"
        forward_gears:
          value: 6 
        reverse_gears:
          value: 1
    Standard6SpeedHPattern:
      class:
        name: "RA::UnitTest::6SpeedShifter"
      dependencies:
        pattern:
          value: "H"
    RidiculouslyModdedLS7Engine:
      class:
        name: "RA::UnitTest::Engine"
      dependencies:
        make:
          value: "Ridiculous Engines R' Us" 
        year:
          value: 2012
        model: 
          value: "LS200"
        displacement:
          value: 14000
        cylinders: 
          value: 16 
        horsepower:
          value: 2000

USING THE CONTAINER

    use Modern::Perl;
    use Test::More;
    use Test::Moose;
    use Test::Exception;
    use Data::Dumper;
    use Cwd 'abs_path';
    use File::Spec;
    use FindBin qw($Bin);

    use lib "$Bin/lib";

    my $abs_path = abs_path($0);

    my ( $volume, $directories, $file ) = File::Spec->splitpath($abs_path);

    my $test_yaml_path = File::Spec->catfile( $directories, 'ra-di-container.yml' );

    ok( -f $test_yaml_path, "test yaml file [ $test_yaml_path ] exists!" );

    use_ok('Syringe');

    my $container = Syringe->instance( path => $test_yaml_path );

    cmp_ok( $container->get_class('StockCar'), 'eq', 'RA::UnitTest::Car', 'get_class' );

    my $car = $container->get_service('StockCar');

    isa_ok( $car, 'RA::UnitTest::Car', 'get_service' );
    does_ok($car, 'RA::UnitTest::CarInterface');
    cmp_ok($car->make,  'eq', 'Chevrolet', 'car correct make');
    cmp_ok($car->model, 'eq', 'Z06', 'car correct model');
    cmp_ok($car->year,  '==', 2007, 'car correct year');

    my $engine = $car->engine;

    isa_ok($engine, 'RA::UnitTest::Engine'); 
    does_ok($engine, 'RA::UnitTest::EngineInterface');
    cmp_ok($engine->make, 'eq', 'GM', 'engine make correct');
    cmp_ok($engine->model, 'eq', 'LS7', 'engine model correct');
    cmp_ok($engine->year, '==', 2007, 'engine year correct');
    cmp_ok($engine->horsepower, '==', 505, 'engine horsepower correct');
    cmp_ok($engine->displacement, '==', 7000, 'engine displacement correct');
    cmp_ok($engine->cylinders, '==', 8, 'engine cylinders correct');

    my $transmission = $car->transmission;

    isa_ok($transmission, 'RA::UnitTest::Transmission');
    does_ok($transmission, 'RA::UnitTest::TransmissionInterface');
    cmp_ok($transmission->make, 'eq', 'Tremec', 'transmission make correct');
    cmp_ok($transmission->model, 'eq', 'T56', 'transmission model correct');

    my $interface = $transmission->interface;
    isa_ok($interface, 'RA::UnitTest::6SpeedShifter');
    does_ok($interface, 'RA::UnitTest::ShifterInterface');
    cmp_ok($interface->pattern, 'eq', 'H', 'transmission interface is correct');

    #-------------------------------------------------------------------------------
    # test that the FastNFuriousCar actualy got instantiated correctly with all
    # of it's dependencies injected.
    #-------------------------------------------------------------------------------

    $car = $container->get_service('FastNFuriousCar');

    isa_ok( $car, 'RA::UnitTest::Car', 'get_service' );
    does_ok($car, 'RA::UnitTest::CarInterface');
    cmp_ok($car->make,  'eq', 'VIN BENZINE', 'car correct make');
    cmp_ok($car->model, 'eq', 'Z006', 'car correct model');
    cmp_ok($car->year,  '==', 2012, 'car correct year');

    $engine = $car->engine;

    isa_ok($engine, 'RA::UnitTest::Engine'); 
    does_ok($engine, 'RA::UnitTest::EngineInterface');
    cmp_ok($engine->make, 'eq', "Ridiculous Engines R' Us", 'engine make correct');
    cmp_ok($engine->model, 'eq', 'LS200', 'engine model correct');
    cmp_ok($engine->year, '==', 2012, 'engine year correct');
    cmp_ok($engine->horsepower, '==', 2000, 'engine horsepower correct');
    cmp_ok($engine->displacement, '==', 14000, 'engine displacement correct');
    cmp_ok($engine->cylinders, '==', 16, 'engine cylinders correct');

    $transmission = $car->transmission;

    isa_ok($transmission, 'RA::UnitTest::Transmission');
    does_ok($transmission, 'RA::UnitTest::TransmissionInterface');
    cmp_ok($transmission->make, 'eq', 'Tremec', 'transmission make correct');
    cmp_ok($transmission->model, 'eq', 'T56', 'transmission model correct');

    $interface = $transmission->interface;
    isa_ok($interface, 'RA::UnitTest::6SpeedShifter');
    does_ok($interface, 'RA::UnitTest::ShifterInterface');
    cmp_ok($interface->pattern, 'eq', 'H', 'transmission interface is correct');

    done_testing();

SO WHY IS THIS USEFUL?!

Dependency Injection is useful for the following reasons:

1. No hardcoded dependencies in the class code.

Since there are no use statements, you don't have to hunt through your code to find them when you change classes you are using. A common example would be an ORM or XML parser.

2. You can easily plug in or inject mocked classes with no negative effects.

Take the example about the cars from above. Those are basically test classes. One could easily write a class that consumes the RA::UnitTest::Engine role that is actually connected to a real engine and inject it into the car class.

With DI, it's very easy to plug'n play code dependencies with minimal code changes. All the changes are done in the configuration file.

3. If you program to interfaces, it's very easy to change implementations.

CONSTRUCTOR

instance

 my $container = Syringe->instance( path         => $yaml_config_file,
                                    log4perlconf => $path_to_conf );

The constructor is 'instance' because this is a singleton class. You must pass the path parameter which should contain the path to the yaml config file. The log4perlconf parameter is optional. If you don't pass one, the default configuration will be used (see logger below).

METHODS

logger

 my $log4perl = $container->logger;

If you don't pass in log4perlconf parameter to the constructor, the following default configuration will be used for Log::Log4perl.

    log4perl.rootLogger=DEBUG,Logfile
    log4perl.category.default=WARN,Logfile
    log4perl.appender.Logfile=Log::Log4perl::Appender::File
    log4perl.appender.Logfile.filename=test.log
    log4perl.appender.Logfile.layout=Log::Log4perl::Layout::PatternLayout
    log4perl.appender.Logfile.layout.ConversionPattern=%d %M %m %n

get_service

 my $object = $container->get_service("ServiceUniqueIdentifier");

Returns an instance of the class associated with a given service.

get_class

 my $class = $container->get_class("ServiceUniqueIdentifier");

Returns the class that the service is mapped to.

register_service

 my $mongodb = MongoDB::Connection->new(host => 'localhost', port => 27017); 
 $container->register_service("MongoDB", $mongodb);

Allows you to add services at runtime. Dependencies will not be handled for you. You must pass a fully instantiated object.

If you want the dependencies automatically handled for you, use the YAML file.

OTHER PERL IOC/DI IMPLEMENTATIONS

Check out IOC and Bread::Board

MORE INFORMATION ABOUT IOC

http://martinfowler.com/articles/injection.html

AUTHOR

Rick Apichairuk, <rick.apichairuk at gmail.com>

COPYRIGHT

Copyright (C) 2012 by Rick Apichairuk

LICENSE

This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.