File Coverage

blib/lib/Treex/PML/Factory.pm
Criterion Covered Total %
statement 41 42 97.6
branch 6 12 50.0
condition 2 5 40.0
subroutine 15 15 100.0
pod 5 5 100.0
total 69 79 87.3


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