Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: st3vil/Net-LastFMAPI
base: ecd1f17510
...
head fork: st3vil/Net-LastFMAPI
compare: 00baba207a
Checking mergeability… Don't worry, you can still create the pull request.
  • 5 commits
  • 1 file changed
  • 0 commit comments
  • 1 contributor
Commits on Dec 04, 2011
@wchristian wchristian better variable names to make extract_rows more readable d2b9541
@wchristian wchristian checks for empty answers made a bit more concise 9aa68f6
@wchristian wchristian don't warn on answers that definitely are empty e3e5c57
@wchristian wchristian symlinks don't work on windows e8f95bc
@wchristian wchristian an empty response is an unrecoverable error. later on ...
... this could be worked around by degrading the limit of the pagination
so we can skip the faulty piece of data and still retrieve everything else.
This will need some clever coding because it'll likely need to degrade down
to 1 and then have to be upgraded again afterwards, but without
encountering the faulty bit again
00baba2
Showing with 15 additions and 14 deletions.
  1. +15 −14 lib/Net/LastFMAPI.pm
View
29 lib/Net/LastFMAPI.pm
@@ -29,10 +29,10 @@ our $sk_symlink = my_home()."/.net-lastfmapi-sessionkey";
sub load_save_sessionkey { # see get_session_key()
my $key = shift;
if ($key) {
- symlink($key, $sk_symlink)
+ write_file($sk_symlink, $key);
}
else {
- $key = readlink($sk_symlink);
+ $key = eval{ read_file($sk_symlink) };
}
$session_key = $key;
}
@@ -262,6 +262,10 @@ sub lastfm {
$params{format} ||= "xml";
my $content = $res->decoded_content;
+ croak "Last.fm contains faulty data for a piece of data you requested and "
+ . "is unable to return a useful reply. Will be treated as an empty reply."
+ if $content eq qq|""\n|;
+
my $decoded_json = sub { $content = decode_json($content); };
unless ($res->is_success &&
($params{format} eq "json" && !exists($decoded_json->()->{error})
@@ -309,22 +313,20 @@ sub _rowify_content {
}
sub extract_rows {
- my ( $rs ) = @_;
+ my ( $content ) = @_;
if (!$last_params{format}) {
croak "returning rows from xml is not supported";
}
- my @rk = keys %$rs;
- my $r = $rs->{$rk[0]};
- my @ks = sort keys %$r;
- unless (@rk == 1 && @ks == 2 && $ks[0] eq '@attr') {
+ my @main_keys = keys %{$content};
+ my $main_data = $content->{$main_keys[0]};
+ my @data_keys = sort keys %{$main_data};
+ unless (@main_keys == 1 && @data_keys == 2 && $data_keys[0] eq '@attr') {
+ my ( $text, $total ) = ( $main_data->{'#text'}, $main_data->{total} );
+ return if defined $text && $text =~ /^\s+$/ && defined $total && $total == 0; # no rows
carp "extracting rows may be broken";
- if (defined $r->{'#text'} && $r->{'#text'} =~ /^\s+$/
- && defined $r->{total} && $r->{total} == 0) { # no rows
- return ();
- };
}
- %last_response_meta = %{ $r->{$ks[0]} };
- my $rows = $r->{$ks[1]};
+ %last_response_meta = %{ $main_data->{$data_keys[0]} };
+ my $rows = $main_data->{$data_keys[1]};
if (ref $rows ne "ARRAY") {
# schemaless translation of xml to data creates these cases
if (ref $rows eq "HASH") { # 1 row
@@ -606,4 +608,3 @@ Steev Eeeriumn <drsteve@cpan.org>
This module is free software. It may be used, redistributed
and/or modified under the terms of the Perl Artistic License
(see http://www.perl.com/perl/misc/Artistic.html)
-

No commit comments for this range

Something went wrong with that request. Please try again.