#!/usr/bin/perl -w -I.
##
## Copyright (c) 2002 Rainer Hillebrand, rainer.hillebrand@webcab.de.
## All rights reserved.
## This program is free software; you can redistribute it
## and/or modify it under the same terms as Perl itself.
##
## Version 0.01, 2002-10-07
##
## This Perl script prints out all capabilities for a browser with a given 
## device_id. The capabilities are recursively derived from all fall back 
## browsers starting with the device_id "generic".

use WURFLLite;

my $device_id = 'upgui_generic'; # device to search for

my $input = 'wurfl.xml';
open(IN,"<$input") || die("Can't open input file $input: $!.");
my $content;
while (<IN>) {
$content .= $_;
}
my %result;
parseXML(\%result, \$content);
print "WURFL version: $result{'versions'}->{'ver'}\n\n";

if (defined %{$result{'devices'}->{$device_id}}) {
print "Device ID: $device_id\n\n",
"  Attributes:\n";
foreach my $attribute (sort {lc($a) cmp lc($b)} keys (%{$result{'devices'}->{$device_id}->{'attributes'}})) {
print
"    $attribute: ", $result{'devices'}->{$device_id}->{'attributes'}->{$attribute}, "\n";

}
print "\n  Capabilities:\n";
my $has_fall_backs = 1;
my @device_ids = ($device_id);
my $fallback = $device_id;
while ($has_fall_backs) {
if (defined $result{'devices'}->{$fallback}->{'attributes'}->{'fall_back'} and
$result{'devices'}->{$fallback}->{'attributes'}->{'fall_back'} ne '' and
$result{'devices'}->{$fallback}->{'attributes'}->{'fall_back'} ne 'root') {
push(@device_ids, $result{'devices'}->{$fallback}->{'attributes'}->{'fall_back'});
$fallback = $result{'devices'}->{$fallback}->{'attributes'}->{'fall_back'};
}
else {
$has_fall_backs = 0
}
}
my (%capabilities, $device);
while ($device = pop(@device_ids)) {
foreach my $group (sort {lc($a) cmp lc($b)} keys (%{$result{'devices'}->{$device}->{'capabilities'}})) {
foreach my $capability (sort {lc($a) cmp lc($b)} keys (%{$result{'devices'}->{$device}->{'capabilities'}->{$group}})) {
$capabilities{$group}->{$capability} = $result{'devices'}->{$device}->{'capabilities'}->{$group}->{$capability};
}
}
}
foreach my $group (sort {lc($a) cmp lc($b)} keys (%capabilities)) {
print
"    $group:\n";
foreach my $capability (sort {lc($a) cmp lc($b)} keys (%{$capabilities{$group}})) {
print
"      $capability: ", $capabilities{$group}->{$capability}, "\n";
}
}
}
else {
print "The device with the ID $device_id does not exist!";
}