The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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<< <nfmnunes@cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-flickr-user@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Flickr-Utils>.
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