The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
###################################################
## YahooRESTGeocode.pm
## Andrew N. Hicox		<andrew@hicox.com>
## Hicox Information Systems Development
##
## a built in XML::Parser style for parsing 
## the xml returned from Yahoo REST webservices
###################################################


## Global Stuff ###################################
package XML::Parser::YahooRESTGeocode;
use 5.6.0;
use Carp;

$VERSION = 0.2;

#register with XML::Parser as built in style
$XML::Parser::Built_In_Styles{YahooRESTGeocode} = 1;

#host data fields
my %node_tree = (
	'Result'	=> ['Latitude','Longitude','Address','City','State','Zip','Country']
);




## Init ###########################################
sub Init {
	my $expat = shift;
    $expat->{'Lists'}	= {};
    $expat->{'Curlist'} = [];			#everything @OPEN used to be
    $expat->{'errstr'}  = ();			#clear out the error string
    $expat->{'errmsg'}	= ();			#clear out the advisory errorrs
	
	#if there's any arguments corresponding to nodes in 'node_tree',
	#evacuate them to '_CDB2IMP_callbacks', they must be code refs
	#we'll execute 'em when one of those nodes ends
	foreach (keys %node_tree){
		if ((exists($expat->{$_})) && (ref ($expat->{$_}) eq "CODE")){
			$expat->{'_YahooREST_callbacks'}->{$_} = $expat->{$_};
			delete($expat->{$_});
		}
	}
    
}




## Start ##########################################
sub Start {
	my ($expat, $element, %p) = @_;
    push (@{$expat->{'Curlist'}}, {
        '_name'			=> $element,
        '_attributes'	=> \%p
    });
}




## Char ###########################################
sub Char {
    my ($expat, $data) = @_;
    unless ($data =~/^\s+$/){
        $expat->{'Curlist'}->[$#{$expat->{'Curlist'}}]->{'_data'} .= $data;
    }
}




## Final ##########################################
sub Final {
	my $expat = shift;
	#handle error
	if ($expat->{'errstr'}){ $XML::Parser::errstr = $expat->{'errstr'}; return (undef); }
	#handle advisory messages
	if ($expat->{'errmsg'}){ $XML::Parser::errmsg = $expat->{'errmsg'}; }
	#clean up
	delete $expat->{Curlist};
	my $out = $expat->{Lists}->{'DATA'};
	delete $expat->{Lists};
	return ($out);
}


## gather_data ####################################
sub gather_data {
    my ($expat, $name) = @_;
    my (@data) = ();
    while ($expat->{'Curlist'}->[$#{$expat->{'Curlist'}}]->{'_name'} ne $name){
        push (@data, pop(@{$expat->{'Curlist'}}));
    };
   #one more to catch the start tag
    push (@data, pop(@{$expat->{'Curlist'}}));
    reverse (@data);
    return (\@data);
}


## extract_pcdata #################################
sub extract_pcdata {
    my $data = shift();
    my %out = ();
    foreach (@{$data}){
        foreach my $f (@_){
            if (($_->{'_name'} eq $f) && ($_->{'_data'} !~/^$/)){
                $out{$f} = $_->{'_data'};
            }
        }
    }
    return (\%out);
}


## End ############################################
sub End { 
	my ($expat, $element) = @_;
	
	if (exists($node_tree{$element})){
	
		my $data = extract_pcdata(gather_data($expat, $element), @{$node_tree{$element}});
		push (@{$expat->{'Lists'}->{'DATA'}->{$element}}, $data);
		
		#if the user defined some callback to execute, do that
		if (exists($expat->{'_YahooREST_callbacks'}->{$element})){
			&{$expat->{'_YahooREST_callbacks'}->{$element}}($data);
		}
	
	}
}

## True ###########################################
1;