package Flickr::API::Utils; use warnings; use strict; =head1 NAME Flickr::API::Utils - Provides helpfull functions for dealing with the Flickr API. =head1 VERSION Version 0.01 =cut our $VERSION = '0.01'; =head1 SYNOPSIS This module provides functions that may be used to "clean up" the response from a Flickr::API call, test results and so on. Usage example: use Flickr::Utils; my $toolbox = Flickr::Utils->new(); my $prettystruct = $toolbox->clean($response_from_flickr_api_call); =head1 FUNCTIONS =head2 new =cut sub new { my $class = shift; my $s = {}; return bless $s, $class; } =head2 clean Takes a structure generated by a Flickr::API call and cleans it up for your Perl code to enjoy. The response from that class is a hash created by a XML parser which is rather difficult to parse. This module gets that response and creates a rather more "perlish" structure with the same information. This cleaning up is done on a fully automated manner so it may still not be what you want. Some rather more usefull modules are Flickr::API::Photos, Flickr::API::People, etc which use this as a first pass at getting a decent response. =cut sub clean { my $s = shift; my $response = shift; my $result = shift; _recurseParse($response->{tree}, $result); } =head2 test_return Checks to see if the response of the Flickr API was successfull or not. If it was successfull fill in the return->success field in the object that was passed on to us, otherwise fill in this field and the other two relevant ones: result->error_code and result->error_message. =cut sub test_return { my $s = shift; my $response = shift; my $result = shift; if (!$response) { $result->{success} = 0; $result->{error_message} = "Didn't get any data to verify"; return 0; } $result->{success} = $response->{success}; if (!$result->{success}) { $result->{error_code} = $response->{error_code}; $result->{error_message} = $response->{error_message}; } return $result->{success}; } =head2 auto_parse Parses a piece of the XML structure (an ARRAY) that the Flickr::API returns according to some rules laid out by the user. =cut sub auto_parse { my $s = shift; my $xml = shift; my $rules = shift; my $result; foreach my $item (@$xml) { next if (($item->{type} eq 'data') and ($item->{content} =~ /^\s*$/ )); if (exists($rules->{$item->{name}})) { if ($rules->{$item->{name}} eq 'attributes') { $result->{$item->{name}} = {}; $s->get_attributes($item, $result->{$item->{name}}); } elsif ($rules->{$item->{name}} eq 'simple_content') { $result->{$item->{name}} = $s->get_simple_content($item); } elsif ($rules->{$item->{name}} eq 'attributes&simple_content') { $result->{$item->{name}} = {}; $s->get_attributes($item, $result->{$item->{name}}); $result->{$item->{name}}{value} = $s->get_simple_content($item); } elsif ($rules->{$item->{name}}{complex} eq 'array') { $result->{$item->{name}} = []; foreach my $arrayitem (@{$item->{children}}) { my $parse_result = $s->auto_parse([$arrayitem], $rules->{$item->{name}}); if ($parse_result) { push @{$result->{$item->{name}}}, $parse_result; } } } elsif ($rules->{$item->{name}}{complex} eq 'flatten_array') { $result = {}; $s->get_attributes($item, $result); foreach my $arrayitem (@{$item->{children}}) { my $parse_result = $s->auto_parse([$arrayitem], $rules->{$item->{name}}); if ($parse_result) { %$result = (%$result, %$parse_result); } } } } else { print STDERR "How odd, I don't know anything about an '".$item->{name}."'element... Ignoring it.\n"; } } return $result; } =head2 get_attributes Gets the attributes for a given node of the XML tree. =cut sub get_attributes { my $s = shift; my $xml = shift; my $result = shift; foreach my $attr (keys %{$xml->{attributes}}) { $result->{$attr} = $xml->{attributes}{$attr}; } } =head2 get_simple_content Gets the content for a given node of the XML tree. It is assumed that this node has a single element with content. =cut sub get_simple_content { my $s = shift; my $xml = shift; return $xml->{children}[0]{content}; } ######################## # Helper functions ######################## sub _recurseParse { my $data = shift; my $result = shift; #return unless (exists($data->{type}) and ($data->{type} eq 'tag')); if (exists($data->{type})) { if ($data->{type} eq 'tag') { foreach my $elem (keys(%{$data->{attributes}})) { $result->{$data->{name}}{$elem} = $data->{attributes}{$elem}; } foreach my $child (@{$data->{children}}) { _recurseParse($child, $result); } } elsif ($data->{type} eq 'data') { if (exists($data->{content}) and defined($data->{content}) and ($data->{content} !~ /^\s*$/)) { $result->{content} = $data->{content}; } } else { return; } } } =head1 AUTHOR Nuno Nunes, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE Copyright 2005 Nuno Nunes, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of Flickr::API::Clean