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