view release on metacpan or  search on metacpan

lib/Parse/ACNS.pm  view on Meta::CPAN

                ...
            ]
        },
        'Notes' => '
            Open area for freeform text notes, filelists, etc...
        '
    }

=cut

sub parse {
    my $self = shift;
    my $xml = shift;
    my $element = $xml->documentElement->nodeName;
    if ( $self->{'version'} eq 'any' ) {
        foreach my $v (qw(1.2 1.1 1.0 0.7 0.6)) {
            local $@;
            my $res;
            return $res if eval { $res = $self->reader($v, $element)->($xml); 1 };
        }
    }
    elsif ( $self->{'version'} eq 'compat' ) {
        my $root = $xml->documentElement;
        my $uri = $root->namespaceURI || '';
        if ( !$uri || ($uri eq 'http://www.movielabs.com/ACNS' && !$root->can('setNamespaceDeclURI')) ) {
            my $list = $root->getElementsByTagNameNS($uri, '*');
            $list->unshift($root);
            $list->foreach(sub {
                $_->setNamespace('http://www.acns.net/ACNS', $root->prefix, 1);
            });
        }
        elsif ( $uri eq 'http://www.movielabs.com/ACNS' ) {
            $root->setNamespaceDeclURI($root->prefix, 'http://www.acns.net/ACNS');
        }
        elsif ( $uri eq 'http://www.acns.net/ACNS' ) {
            # do nothing
        }
        elsif ( $uri =~ m{^http://www\.acns\.net\b}i ) {
            $root->setNamespaceDeclURI($root->prefix, 'http://www.acns.net/ACNS');
        }
        else {
            die "Top level element has '$uri' namespace and it's not something we can parse as ACNS";
        }
        return $self->reader($self->{'version'}, $element)->($xml);
    }
    else {
        return $self->reader($self->{'version'}, $element)->($xml);
    }
    return undef;
}

my %NS = (
    '1.0' => 'http://www.movielabs.com/ACNS',
    '1.1' => 'http://www.movielabs.com/ACNS',
    '1.2' => 'http://www.acns.net/ACNS',
    'compat' => 'http://www.acns.net/ACNS',
);
my %SUPLIMENTARY = (
    '1.0' => ['xmlmime'],
    '1.1' => ['xmlmime'],
    '1.2' => ['xmlmime', 'xmldsig'],
);

sub reader {
    my $self = shift;
    my $version = shift;
    my $element = shift || 'Infringement';

    return $CACHE{$version}{'element'}{$element}
        if $CACHE{$version}{'element'}{$element};

    my $schema = $CACHE{$version}{'schema'} ||= do {
        my @paths;
        push @paths, File::ShareDir::dist_file(
            'Parse-ACNS',
            File::Spec->catfile( 'schema', $version, 'acns.xsd' )
        );
        if ( $SUPLIMENTARY{$version} ) {
            push @paths, map File::ShareDir::dist_file(
                'Parse-ACNS',
                File::Spec->catfile( 'schema', "$_.xsd" )
            ), @{$SUPLIMENTARY{$version}};
        }
        XML::Compile::Schema->new( \@paths );
    };

    use XML::Compile::Util qw/pack_type/;
    return $CACHE{$version}{'element'}{$element}
            = $schema->compile( READER => pack_type( $NS{$version}, $element ) );

}

=head1 AUTHOR

Ruslan Zakirov E<lt>ruz@bestpractical.comE<gt>

=head1 LICENSE

Under the same terms as perl itself.

=cut

1;