C:\> perl lastfm.pl --user=delphinus_iddqd

getting Last.FM chart...
tracks prepared
folder named '[! Recently Added]' not found
playlist named '! Last.fm Chart' created successfully

Black Pearl - Bounty Island (DJ Shah's San Antonio Harbour Mix)
Suncatcher feat. Aneym - Underneath My Skin (Luke Terry Remix)
Nu NRG - Kosmosy
Sequentia - Infinite Horizon (Original Mix)
Weirdo - Beyond (Paul Glazby Remix)
Breakfast - The Sunlight (Original Mix)
Mango Pres. Shoreliners - Handelskai (Part 2) (Original Mix)
Kalwi & Remi Vs. John Marks - Revolution (John Marks Mix)
Chris Reece & Dinka - Autumn Leaves (Michael Cassette Remix)
Corderoy - Kyrie (Original Dub Mix)
Jamaster A - Bells Of Tiananmen (Airbase Remix)
Odonbat - Ray (Adriz Remix)
Seventh Heaven - Dolphins (Stoneface & Terminal Remix)
Andy McAndersen - Shine (Dmitry Bessonov Remix)
Van Dresen & Thrice - Subnative (Cor Fijneman Remix)
DJ Orkidea - Better Day
Oceania pres. Cordonnier - Squares In Boxes (Suncatcher Remix)
Reaky - Meduza
XGenic - Inside (Original Mix)
Jonas Steur - Castamara (Original Mix)

added successfully

C:\>

#!/usr/bin/perl
package MyApp;
use feature qw! say switch !;
use errors -with_using;
use Moose;
with "MooseX::Getopt";

use List::Util qw! shuffle reduce !;
use LWP::Simple qw! get !;
use Win32::OLE;
use XML::Simple;

# Last.FMのユーザー名（必須）
has user => ( is => "ro", isa => "Str", required => 1 );
# チャートの取得期限
# 1 .. 5 の値をとる（初期値：1）
has period => ( is => "ro", isa => "Int", default => 1 );
# プレイリストの名前（初期値：! Last.fm Chart）
has pls_name => ( is => "ro", isa => "Str", default => "! Last.fm Chart" );
# プレイリストを置くフォルダー（初期値：[! Recently Added]）
has pls_folder => (is => "ro", isa => "Str", default => "[! Recently Added]" );
# チャートに登録するトラック数（初期値：20）
has track_amount => ( is => "ro", isa => "Int", default => 20 );
# チャートの上位何位までを候補とするか（初期値：100）
has max_rank => ( is => "ro", isa => "Int", default => 100 );
# 同じタイトル名をいくつまで許容するか（初期値：20）
has allow_amount => ( is => "ro", isa => "Int", default => 20 );

# チャートに追加しない曲のリスト（プログラムリストの一番最後に追加する）
has _not_add => ( is => "ro", isa => "ArrayRef", auto_deref => 1,
  default => sub {
    my @ary;
    push @ary, [ /(.*) - (.*)/ ] while <main::DATA>;
    \@ary;
  } );

# チャートのURLをパラメータに合わせて作成する
has _url_prefix => ( is => "ro", isa => "Str",
  default => "http://ws.audioscrobbler.com/2.0/user/%s/" );
has _feed => ( is => "ro", isa => "Str", lazy_build => 1 );
sub _build__feed { my $self = shift;
  my $p = $self->_url_prefix;
  given ( $self->period ) {
    when ( 1 ) {
      return sprintf $p . "weeklytrackchart.xml", $self->user;
    }
    when ( [ 2, 3, 4 ] ) {
      return sprintf $p . "toptracks.xml?period=%dmonth",
      $self->user, ( 3, 6, 12 )[ $_ - 2 ];
    }
    when ( 5 ) {
      return sprintf $p . "toptracks.xml", $self->user;
    }
    default {
      die "can't use period '$_'";
    }
  }
}

# iTunesオブジェクト
has _iTunes => ( is => "ro", isa => "Object",
  default => sub {
    try {
      Win32::OLE->CreateObject( "iTunes.Application" );
    } catch Error using {
      throw Error "can't run iTunes";
    };
  } );

# 初期設定
sub BUILD { my $self = shift;
  binmode STDOUT => ":raw :encoding(cp932)";
  $|++;
  Win32::OLE->Option(
    CP => Win32::OLE::CP_UTF8,
    Warn => 3,
  );
}

# メインルーチン
sub run { my $self = shift;
  # チャートのデータを取得する
  say "getting Last.FM chart...";
  my $data = $self->_load_last_fm;

  # データから登録すべきトラックを取得する
  my @tracks = $self->_get_tracks( $data );
  say "tracks prepared";

  # iTunes上でプレイリストを用意する
  my $playlist = $self->_make_playlist;
  say "playlist named '" . $self->pls_name . "' created successfully";

  # プレイリストにトラックを追加する
  $self->_add_to_playlist( $playlist, @tracks );
  say "added successfully";
}

# チャートのデータを取得する
sub _load_last_fm { my $self = shift;
  my $xml = try {
    get $self->_feed;
  } catch Error using {
    throw Error "can't get Last.FM feed : $_";
  };
  XML::Simple->new->XMLin( $xml );
}

# データから登録すべきトラックを取得する
sub _get_tracks { my $self = shift;
  my $data = shift;

  # トラックをランクの順に並べ替え
  my @whole_tracks;
  while ( my ( $k, $v ) = each %{ $data->{track} } ) {
    my @info = ( $v->{artist}{content} || $v->{artist}{name},
      $k, $v->{rank} );
    # 「追加しない曲のリスト」に入ってるかどうか確認。
    my @flag = grep { $_->[0] eq $info[0] and $_->[1] eq $info[1] }
      $self->_not_add;
    # 入ってなければ追加する
    @flag or push @whole_tracks, \@info;
  }
  @whole_tracks = sort { $a->[2] <=> $b->[2] } @whole_tracks;

  # 取得上限までのトラックをシャッフル
  my $max = $self->max_rank > @whole_tracks ? @whole_tracks : $self->max_rank;
  my @sample_tracks = shuffle @whole_tracks[ 0 .. $max - 1 ];

  # トラックを並べる
  my @tracks;
  my $max_amount = $self->track_amount > @sample_tracks
    ? @sample_tracks : $self->track_amount;
  while ( @tracks < $max_amount and @sample_tracks ) {
    # iTunesからトラックを得る
    try {
      push @tracks, $self->_get_from_itunes( shift @sample_tracks );
    } catch Error using {
      say $_;
    };
  }

  @tracks;
}

# iTunesからトラックを得る
sub _get_from_itunes { my $self = shift;
  my ( $artist, $title ) = @{ $_[0] };

  # まずはタイトルで検索
  my @tracks = try {
    my $f = sub {
      $self->_iTunes->LibraryPlaylist->Search( shift, 5 );
    };
    my $found = $f->( $title );
    # 見つからなければ括弧を取ってみる
    unless ( $found ) {
      $title =~ s/\s*\(.*\)\s*$//;
      $found = $f->( $title );
      # それでもなければ諦める
      $found or throw Error;
    }
    my @tmp;
    push @tmp, $found->Item( $_ ) for 1 .. $found->Count;
    @tmp;
  } catch Error using {
    throw Error "can't find title '$title'";
  };

  # 一個しかなかったらそれを返して終了
  @tracks == 1 and return $tracks[0];

  # 次にその中からアーティスト名で検索
  my $re = qr/$artist/i;
  my @same_artist = grep { $_->Artist =~ $re } @tracks;
  # 見つからなければ“feat”とか“&”以降を削ってみる
  unless ( @same_artist > 0 ) {
    $artist =~ s/\s*(feat|&).*$//;
    $re = qr/^$artist/;
    @same_artist = grep { $_->Artist =~ $re } @tracks;
  }

  # 特定されたら、それでトラックリストを置き換える
  if ( @same_artist ) {
    @tracks = @same_artist;

  # 見つからず、しかも最大許容数を超えてる場合は失敗
  } elsif ( @tracks > $self->allow_amount ) {
    throw Error;
  }

  # 再生数が一番多いモノを返す
  reduce { $a->PlayedCount > $b->PlayedCount ? $a : $b } @tracks;
}

# iTunes上でプレイリストを用意する
sub _make_playlist { my $self = shift;
  # すでにプレイリストが存在するなら、いったん削除する
  try {
    $self->_iTunes->LibrarySource->Playlists
      ->ItemByName( $self->pls_name )->Delete;
  } catch Error using {
    say "playlist named '" . $self->pls_name . "' not found";
  };

  # プレイリストを作成するフォルダー
  # 無ければライブラリの直下に作成する
  my $folder = try {
    if ( my $f = $self->_iTunes->LibrarySource->Playlists
      ->ItemByName( $self->pls_folder ) ) {
      $f;
    } else {
      say sprintf "folder named '%s' not found", $self->pls_folder;
      $self->_iTunes;
    }
  } catch Error using {
    throw Error "folder not found";
  };

  # プレイリスト作成
  try {
    $folder->CreatePlaylist( $self->pls_name );
  } catch Error using {
    throw Error "can't create playlist";
  };
}

# プレイリストにトラックを追加する
sub _add_to_playlist { my $self = shift;
  my ( $playlist, @tracks ) = @_;
  say "";
  for my $t ( @tracks ) {
    my $info = sprintf "%s - %s", $t->Artist, $t->Name;
    try {
      $playlist->AddTrack( $t );
      say "    Added '$info'";
    } catch Error using {
      say "can't add '$info'";
    };
  }
  say "";
}

__PACKAGE__->meta->make_immutable;

package main;
MyApp->new_with_options->run;

__DATA__
ID - ID