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