File Coverage

blib/lib/Treex/PML/Factory.pm
Criterion Covered Total %
statement 23 42 54.7
branch 0 12 0.0
condition 0 5 0.0
subroutine 9 15 60.0
pod 5 5 100.0
total 37 79 46.8


line stmt bran cond sub pod time code
1             package Treex::PML::Factory;
2              
3 1     1   13 use 5.008;
  1         2  
4 1     1   3 use strict;
  1         1  
  1         13  
5 1     1   3 use warnings;
  1         1  
  1         18  
6              
7 1     1   3 use vars qw($VERSION);
  1         1  
  1         31  
8             BEGIN {
9 1     1   14 $VERSION='2.21'; # version template
10             }
11 1     1   3 use Carp;
  1         0  
  1         37  
12 1     1   3 use UNIVERSAL::DOES;
  1         1  
  1         219  
13              
14             my $default_factory;
15              
16             sub DOES {
17 0     0 1   my ($self,$role)=@_;
18 0 0         if ($role eq __PACKAGE__) {
19             # we don't implement Treex::PML::Factory interface, but anything derived from use is assumed to do so
20 0 0         return ref($role) eq __PACKAGE__ ? 0 : 1;
21             } else {
22 0           return $self->DOES($role);
23             }
24             }
25              
26             sub new {
27 0     0 1   my $class = shift;
28 0           return bless {@_}, $class;
29             }
30              
31             sub make_default {
32 0     0 1   my $obj = shift;
33 0   0       my $class = ref($obj) || $obj;
34              
35 0 0         die __PACKAGE__." is not a proper factory and cannot be made default!\n"
36             if $class eq __PACKAGE__;
37              
38 0           my $prev = Treex::PML::Factory->get_default_factory;
39 0 0 0       unless ((ref($prev)||'') eq $class) {
40 0 0         Treex::PML::Factory->set_default_factory(ref($obj) ? $obj : $class->new(@_));
41             }
42 0           return $prev;
43             }
44              
45             sub set_default_factory {
46 0     0 1   my ($self,$factory)=@_;
47 0 0         die __PACKAGE__."->set_default_factory: argument must implement ".__PACKAGE__."!"
48             unless UNIVERSAL::DOES::does($factory,__PACKAGE__);
49 0           $default_factory = $factory;
50             }
51              
52             sub get_default_factory {
53 0     0 1   return $default_factory;
54             }
55              
56             BEGIN {
57 1     1   4 no strict 'refs';
  1         1  
  1         54  
58 1     1   2 for my $method (qw(
59             createPMLSchema createPMLInstance
60             createDocument createDocumentFromFile
61             createFSFormat
62             createNode createTypedNode createList createSeq
63             createAlt createContainer createStructure
64             )) {
65 0     0     *$method = sub { shift; $default_factory->$method(@_) }
  0            
66 12         52 }
67             }
68              
69             1;
70             __END__