File Coverage

blib/lib/Treex/PML/Schema/Import.pm
Criterion Covered Total %
statement 28 77 36.3
branch 0 30 0.0
condition 0 44 0.0
subroutine 10 15 66.6
pod 3 4 75.0
total 41 170 24.1


line stmt bran cond sub pod time code
1             package Treex::PML::Schema::Import;
2              
3 1     1   3 use strict;
  1         1  
  1         21  
4 1     1   3 use warnings;
  1         1  
  1         25  
5              
6 1     1   3 use vars qw($VERSION);
  1         1  
  1         32  
7             BEGIN {
8 1     1   14 $VERSION='2.21'; # version template
9             }
10 1     1   3 no warnings 'uninitialized';
  1         1  
  1         22  
11 1     1   2 use Carp;
  1         1  
  1         47  
12 1     1   474 use URI;
  1         3049  
  1         20  
13 1     1   5 use Treex::PML::Schema::Constants;
  1         1  
  1         74  
14 1     1   485 use Encode;
  1         6754  
  1         61  
15              
16 1     1   4 use base qw(Treex::PML::Schema::XMLNode);
  1         1  
  1         591  
17              
18 0     0 1   sub get_decl_type { return(PML_IMPORT_DECL); }
19 0     0 1   sub get_decl_type_str { return('import'); }
20              
21             sub schema {
22 0     0 0   my ($self)=@_;
23 0           $self=$self->{-parent} while $self->{-parent};
24 0           return $self;
25             }
26              
27             sub simplify {
28 0     0 1   my ($import,$opts)=@_;
29 0           my $target = $import->schema;
30 0   0       my $base_url = $target->{URL}||'';
31 0           my $parent = $import->{-parent}; # FIXME: for templates
32             return if
33             ($parent->get_decl_type == PML_TEMPLATE_DECL and $opts->{no_template_import} or
34 0 0 0       $parent->get_decl_type == PML_SCHEMA_DECL and $opts->{no_import});
      0        
      0        
35 0 0         die "Missing 'schema' attribute on element in $base_url!" unless $import->{schema};
36              
37 0   0       $opts->{schemas}||={};
38 0           my $url = URI->new(Encode::encode_utf8($import->{schema}));
39              
40             my $schema = ref($target)->new({
41 0           (map { ($_=>$opts->{$_}) } qw(schemas use_resources validate)),
42             filename => $url,
43             base_url => $base_url,
44             imported => 1,
45             (map {
46 0 0         exists($import->{$_}) ? ( $_ => $import->{$_} ) : ()
  0            
47             } qw(revision minimal_revision maximal_revision)),
48             revision_error => "Error importing schema %f to $base_url - revision mismatch: %e"
49             });
50 0 0 0       if ((!exists($import->{type}) and
      0        
      0        
51             !exists($import->{template}) and
52             !exists($import->{root})
53             ) or defined($import->{type}) and $import->{type} eq '*') {
54             # print STDERR "IMPORTING *\n";
55 0 0         if (ref $schema->{type}) {
56 0   0       $parent->{type}||={};
57 0           foreach my $name (keys(%{$schema->{type}})) {
  0            
58 0 0         unless (exists $parent->{type}{$name}) {
59 0           $parent->{type}{$name}=$parent->copy_decl($schema->{type}{$name});
60             }
61             }
62             }
63             } else {
64 0           my $name = $import->{type};
65             # print STDERR "IMPORTING $name\n";
66 0 0         if (ref($schema->{type})) {
67 0           $import->_import_type($parent,$schema,$name);
68             }
69             }
70 0 0 0       if ((!exists($import->{type}) and
      0        
      0        
71             !exists($import->{template}) and
72             !exists($import->{root})
73             ) or defined($import->{template}) and $import->{template} eq '*') {
74 0 0         if (ref $schema->{template}) {
75 0   0       $parent->{template}||={};
76 0           foreach my $name (keys(%{$schema->{template}})) {
  0            
77 0 0         unless (exists $parent->{template}{$name}) {
78 0           $parent->{template}{$name}=$parent->copy_decl($schema->{template}{$name});
79             }
80             }
81             }
82             } else {
83 0           my $name = $import->{template};
84 0 0         if (ref($schema->{template})) {
85 0 0         unless (exists $parent->{template}{$name}) {
86 0           $parent->{template}{$name}=$parent->copy_decl($schema->{template}{$name});
87             }
88             }
89             }
90 0 0 0       if (((!exists($import->{type}) and
      0        
      0        
91             !exists($import->{template}) and
92             !exists($import->{root})
93             ) or defined($import->{root}) and $import->{root} eq '1') and !exists($parent->{root}) and $schema->{root}) {
94 0           $parent->{root} = $parent->copy_decl($schema->{root});
95             }
96 0           return $schema;
97             }
98              
99             sub _import_type {
100 0     0     my ($self,$target,$src_schema, $name) = @_;
101 0 0         unless (exists $src_schema->{type}{$name}) {
102 0           croak "Cannot import type '$name' from '$src_schema->{URL}' to '$target->{URL}': type not declared in the source schema\n";
103             }
104 0           my $type = $src_schema->{type}{$name};
105 0           my %referred = ($name => $type);
106 0           $src_schema->_get_referred_types($type,\%referred);
107 0           foreach my $n (keys %referred) {
108 0 0         unless (exists $target->{type}{$n}) {
109 0           $target->{type}{$n}=$target->copy_decl($referred{$n});
110             } else {
111             # print STDERR "already there\n";
112             }
113             }
114             }
115              
116              
117             1;
118             __END__