Jan Engelhardt
81a4534b9d
prefixes OBS-URL: https://build.opensuse.org/package/show/mozilla:addons/mozaddon-devel?expand=0&rev=4
85 lines
1.4 KiB
Perl
85 lines
1.4 KiB
Perl
#!/usr/bin/perl -w
|
|
#
|
|
# authored by Jan Engelhardt, 2011-03-24
|
|
# released into the Public Domain
|
|
#
|
|
use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
|
|
use XML::Simple;
|
|
&main();
|
|
|
|
sub get_rdf
|
|
{
|
|
my $file = shift @_;
|
|
|
|
if ($file eq "install.rdf") {
|
|
return XMLin($file);
|
|
}
|
|
if (substr($file, -4, 4) eq ".xpi") {
|
|
my $zip = Archive::Zip->new();
|
|
if ($zip->read($file) != AZ_OK) {
|
|
die "zip file read error\n";
|
|
}
|
|
my $data = $zip->contents("install.rdf");
|
|
die "missing install.rdf in $file\n" unless $data;
|
|
return XMLin($data);
|
|
}
|
|
die "unsupported file format\n";
|
|
}
|
|
|
|
sub get_desc
|
|
{
|
|
my $xml = shift @_;
|
|
my $desc;
|
|
foreach my $tag (keys %$xml) {
|
|
if ($tag !~ m{^(\w+:)?Description$}) {
|
|
next;
|
|
}
|
|
if (ref($xml->{$tag}) eq "ARRAY") {
|
|
return $xml->{$tag};
|
|
}
|
|
return [$xml->{$tag}];
|
|
}
|
|
}
|
|
|
|
sub get_id
|
|
{
|
|
my $desc = shift @_;
|
|
my $id;
|
|
|
|
foreach (qw(id em:id)) {
|
|
if (exists($desc->{$_})) {
|
|
$id = $desc->{$_};
|
|
last;
|
|
}
|
|
}
|
|
return $id;
|
|
}
|
|
|
|
sub main
|
|
{
|
|
my $file = shift @ARGV;
|
|
if (!defined($file)) {
|
|
print "Usage: $0 {install.rdf|something.xpi}\n";
|
|
exit 1;
|
|
}
|
|
my $xml = get_rdf($file);
|
|
if (!defined($xml)) {
|
|
die "xml: $!\n";
|
|
}
|
|
my $desc_list = &get_desc($xml);
|
|
my $id;
|
|
foreach my $one_desc (@$desc_list) {
|
|
my $value = &get_id($one_desc);
|
|
if ($value =~ /\@|{[[:xdigit:]]+-/) {
|
|
if (defined($id)) {
|
|
print STDERR "Warning: multiple IDs/UUIDs!\n";
|
|
}
|
|
$id = $value;
|
|
}
|
|
}
|
|
if (!defined($id)) {
|
|
exit 1;
|
|
}
|
|
print "$id\n";
|
|
}
|