view release on metacpan or  search on metacpan

lib/XML/Compile/Translate.pm  view on Meta::CPAN

sub _registerNSprefix($$$)
{   my ($self, $prefix, $uri, $used) = @_;
    my $table = $self->{prefixes};

    if(my $u = $table->{$uri})    # namespace already has a prefix
    {   $u->{used} += $used;
        return $u->{prefix};
    }

    my %prefs = map +($_->{prefix} => 1), values %$table;
    my $take;
    if(defined $prefix && !$prefs{$prefix}) {   $take = $prefix }
    elsif(!$prefs{''}) { $take = '' }
    else
    {   # prefix already in use; create a new x\d+ prefix
        my $count = 0;
        $count++ while exists $prefs{"x$count"};
        $take    = 'x'.$count;
    }
    $table->{$uri} = {prefix => $take, uri => $uri, used => $used};
    $take;
}

sub anyType($)
{   my ($self, $node) = @_;
    pack_type $node->namespaceURI, 'anyType';
}

lib/XML/Compile/Translate/Writer.pm  view on Meta::CPAN

           , type => $type, kind => ref $node, path => $path;
    }

    return (\@attrs, \@elems);
}

sub makeAnyAttribute
{   my ($self, $path, $handler, $yes, $no, $process) = @_;
    my %yes   = map +($_ => 1), @{$yes || []};
    my %no    = map +($_ => 1), @{$no  || []};
    my $prefs = $self->{prefixes};

    weaken $self;

    bless
    sub { my ($doc, $values) = @_;

          my @res;
          foreach my $label (sort keys %$values)
          {   my ($type, $ns, $local);
              if(substr($label, 0, 1) eq '{')
              {   ($ns, $local) = unpack_type $label;
                  $type         = $label;
              }
              elsif(index($label, ':') >= 0)
              {   (my $prefix, $local) = split ':', $label, 2;
                  my $match = first {$_->{prefix} eq $prefix} values %$prefs;
                  my $ns    = $match ? $match->{uri} : undef;
                  $type     = pack_type $ns, $local;
              }
              else {next}  # not fully qualified, not an 'any'

              $yes{$ns} or next if keys %yes;
              $no{$ns} and next if keys %no;

              my $value = delete $values->{$label} or next;
              my ($attrs, $elems) = _split_any_list $path, $type, $value;

lib/XML/Compile/Translate/Writer.pm  view on Meta::CPAN

              push @res, @$attrs;
          }
          @res;
        }, 'ANY';
}

sub makeAnyElement
{   my ($self, $path, $handler, $yes, $no, $process, $min, $max) = @_;
    my %yes   = map +($_ => 1), @{$yes || []};
    my %no    = map +($_ => 1), @{$no  || []};
    my $prefs = $self->{prefixes};

    $handler ||= 'SKIP_ALL';
    weaken $self;

    bless
    sub { my ($doc, $values) = @_;
          my @res;

          foreach my $label (sort keys %$values)
          {   my ($type, $ns, $local);
              if(substr($label, 0, 1) eq '{')
              {   ($ns, $local) = unpack_type $label;
                  $type         = $label;
              }
              elsif(index($label, ':') >= 0)
              {   (my $prefix, $local) = split ':', $label, 2;
                  my $match = first {$_->{prefix} eq $prefix} values %$prefs;
                  $ns    = $match ? $match->{uri} : undef;
                  $type  = pack_type $ns, $local;
              }
              else {next}  # not fully qualified, not an 'any'

              $yes{$ns} or next if keys %yes;
              $no{$ns} and next if keys %no;

              my $value = delete $values->{$label} or next;
              my ($attrs, $elems) = _split_any_list $path, $type, $value;