#!/usr/bin/perl
# $Id$
use strict;
use warnings;
use Carp;

our($iTunesLibrary, $FileSystemEncoding, $NetServerDriver);

package iTunes::RSSServer;
use base qw( HTTP::Server::Simple::Authen HTTP::Server::Simple::CGI );
use Authen::Simple::Passwd;
use Encode;
use File::HomeDir;
use HTTP::Date;
use MIME::Base64;
use List::Util qw( first );

sub title {
    my $self = shift;
    $self->{title} = shift if @_;
    $self->{title};
}

sub set_passwd {
    my $self = shift;
    $self->{passwd} = shift;
}

sub authen_handler {
    my $self = shift;
    Authen::Simple::Passwd->new(passwd => $self->{passwd});
}

sub load_library {
    my($self, $library) = @_;
    $iTunesLibrary = iTunes::RSSServer::Library->new($library);
}

sub reload_library {
    my $self = shift;
    $self->load_library($iTunesLibrary->file);
}

sub handle_request {
    my($self, $cgi) = @_;

    my $user;
    if ($self->{passwd}) {
	$user = $self->authenticate or warn "Login attempt failed.\n", return;
    }

    print STDERR $ENV{REQUEST_METHOD}, " ", $cgi->path_info, " $ENV{REMOTE_ADDR}", ($user ? " [$user]\n" : "\n");

    print "HTTP/1.0 200 OK\r\n" unless $cgi->path_info =~ m!^/files/!;
    if ($cgi->path_info =~ m!^/icon!) {
        $self->handle_feed_icon($cgi);
    } elsif ($cgi->path_info =~ m!^/rss/(\w+)$!) {
        $self->handle_enclosure($cgi, $1);
    } elsif ($cgi->path_info =~ m!^/files/(\w+)/(\d+)!) {
        $self->handle_raw($cgi, $1, $2);
    } elsif ($cgi->path_info =~ m!^/artwork/(\w+)/(\d+)!) {
        $self->handle_artwork($cgi, $1, $2);
    } elsif ($cgi->path_info =~ m!^/reload$!) {
        $self->reload_library();
        $self->handle_playlists($cgi);
    } else {
        $self->handle_playlists($cgi);
    }
}

sub load_feed_icon {
    my $self = shift;
    $self->{feed_icon} = decode_base64(join '', <DATA>);
}

sub handle_feed_icon {
    my($self, $cgi) = @_;
    print $cgi->header('image/gif'), $self->{feed_icon};
}

sub print_header {
    my($self, $cgi) = @_;
    print <<HTML;
<html>
<head><title>iTunes RSS Server (@{[ $cgi->escapeHTML($self->title) ]})</title>
<style>
h1, h2, h3 { font-size: 1.2em }
body { font-family: trebuchet MS; font-size: 12px }
ul { list-style-type: none; margin-left: 0 }
a  { color: #000 }
</style>
</head>
<body>
<h1>iTunes RSS Server</h1>
HTML
}

sub handle_playlists {
    my($self, $cgi) = @_;
    binmode STDOUT, ":encoding(utf-8)";
    print $cgi->header('text/html; charset=utf-8');
    $self->print_header($cgi);
    print "<ul>";
    for my $playlist ($iTunesLibrary->playlists) {
        print $cgi->li($cgi->a({ href => $self->url . "/rss/" . $playlist->PersistentID }, $cgi->img({ src => "/icon", style => "border:0; vertical-align: text-middle" })) . " ", $self->encode_xml($playlist->Name));
    }
    print "</ul>\n";
    print $cgi->a({ href => $self->url . "/reload" }, "Reload Music Library");
    print "</body></html>";
}

sub handle_enclosure {
    my($self, $cgi, $id) = @_;
    binmode STDOUT, ":encoding(utf-8)";
    print $cgi->header('text/xml; charset=utf-8');
    my $playlist = $iTunesLibrary->find_playlist($id);
    my @tracks = $playlist->tracks;
    my $cover_track = first { $_->has_artwork && $_->Location !~ /\.m4p$/ } @tracks;
    my $feed_title = $playlist->Name . " (" . $self->title . ")";
    print <<XML;
<?xml version="1.0" encoding="utf-8"?>
<rss xmlns:itunes="http://www.itunes.com/DTDs/Podcast-1.0.dtd" version="2.0">
<channel>
<title>@{[ $self->encode_xml($feed_title) ]}</title>
<description>RSS 2.0 feed created by iTunes RSS Server</description>
<link>@{[ $self->url ]}/</link>
XML

    if ($cover_track) {
        print <<XML;
<image>
<url>@{[ $self->url ]}/artwork/@{[ $playlist->PersistentID ]}/@{[ $cover_track->TrackID ]}.jpg</url>
<title>@{[ $self->encode_xml($feed_title) ]}</title>
</image>
XML
    }

    my $pubdate = HTTP::Date::time2str(time); # RFC822 date format
    for my $track (@tracks) {
        my $path = $track->location_path;
        unless (-e $path) {
            warn "$path doesn't exist. Skipped.\n";
            next;
        }
        my $url = $self->url . "/files/" . $playlist->PersistentID . "/" . $track->TrackID;

        my($media, $subtype) = $track->mime_type($self->via_psp);
        next if $self->via_psp && $subtype !~ /^mp[34]$/;
        print <<XML;
<item>
<title>@{[ $self->encode_xml(($track->Artist || 'No Artist') . " - " . $track->Name) ]}</title>
<link>$url</link>
<pubDate>$pubdate</pubDate> 
<enclosure url="$url.$subtype" length="@{[ -s $path ]}" type="$media/$subtype" />
</item>
XML
    }
    print "</channel></rss>\n";
}

sub via_psp {
    my $self = shift;
    $ENV{HTTP_USER_AGENT} =~ /PSPRssChannel-agent/;
}

sub url {
    my $self = shift;
    if ($ENV{HTTP_HOST}) {
        return "http://$ENV{HTTP_HOST}";
    } else {
        require Sys::HostIP;
        my $host = Sys::HostIP::hostip();
        return "http://$host:" . $self->port;
    }
}

sub encode_xml {
    my($self, $string) = @_;
    $string =~ s/&/&amp;/g;
    $string =~ s/</&lt;/g;
    $string =~ s/>/&gt;/g;
    $string =~ s/"/&quot;/g;
    $string;
}

sub handle_artwork {
    my($self, $cgi, $pid, $id) = @_;
    my $playlist = $iTunesLibrary->find_playlist($pid);
    my $track    = $playlist->find_track($id);
    my($mime, $artwork) = $track->artwork;
    if ($artwork) {
        my $length = bytes::length($artwork);
        print $cgi->header(-type => $mime, -content_length => $length);
        if ($ENV{REQUEST_METHOD} ne 'HEAD') {
            print $artwork;
        }
    } else {
        print "HTTP/1.0 404 Not Found\r\nContent-Type: text/html\r\n\r\nNot Found";
    }
}

sub handle_raw {
    my($self, $cgi, $pid, $id) = @_;
    my $playlist = $iTunesLibrary->find_playlist($pid);
    my $track    = $playlist->find_track($id);

    my $file = $track->location_path;
    my $mime = $track->mime_type($self->via_psp);

    if ($ENV{HTTP_RANGE} && $ENV{HTTP_RANGE} =~ m!^bytes=(\d*)-(\d*)$!) {
        use bytes;
        my($from, $to) = ($1, $2);
        open my $in, $file or die "$file: $!";
        my $size = -s $in;
        $to    ||= $size - 1;

        print "HTTP/1.0 206 Partial content\r\n";
        print "Content-Type: $mime\r\n",
            "Content-Length: @{[$to - $from + 1]}\r\n",
            "Content-Range: bytes $from-$to/$size\r\n\r\n";
        sysseek $in, $from, 0;
        my $remain = $to - $from + 1;
        while ($remain > 0) {
            sysread($in, my($out), 1024);
            print $out;
            $remain -= length $out;
        }
    } else {
        my $size = -s $file;
        print "HTTP/1.0 200 OK\r\n";
	print "Content-Type: $mime\r\nContent-Length: $size\r\n\r\n";
        if ($ENV{REQUEST_METHOD} eq 'GET') {
            open my $in, $file or die "$file: $!";
            print $_ while <$in>;
        }
    }
}

sub net_server { $NetServerDriver ? "Net::Server::$NetServerDriver" : undef }

package iTunes::RSSServer::Library;
use File::Spec;
use List::Util qw( first );

sub new {
    my($class, $file) = @_;    
    my $self = bless { }, $class;
    $self->init($file);
    $self;
}

sub file { shift->{file} }

sub init {
    my($self, $file) = @_;
    unless ($file) {
        if ($^O eq 'MSWin32') {
            my $mymusic = File::HomeDir::Windows->my_win32_folder('My Music');
            $file = File::Spec->catfile($mymusic, 'iTunes', 'iTunes Music Library.xml');
        } elsif ($^O eq 'darwin') {
            $file = File::Spec->catfile($ENV{HOME}, 'Music', 'iTunes', 'iTunes Music Library.xml');
        } else {
            die "I can't guess library.xml path using your OS name $^O. Specify using --library option.";
        }
    }

    open my $in, "<:encoding(utf-8)", $file or die "$file: $!";
    warn "reading $file\n";

    my($playlists, $tracks, $in_playlist, $curr_id, $is_master, $pl_name, $pl_id);
    my $pl_idx = -1;
    while (<$in>) {
        if ($in_playlist) {
            if ($is_master) {
                m!</array>! and $is_master = 0;
                next;
            }

            m!<key>Master</key><true/>! and $is_master = 1;
            m!<key>Name</key><string>(.*?)</string>!
                and $pl_name = $1;
            m!<key>Playlist ID</key><integer>(.*?)</integer>!
                and $pl_id = $1;
            m!<key>Playlist Persistent ID</key><string>(\w+)</string>!
                and do { $pl_idx++;
                         $playlists->[$pl_idx]->{PersistentID} = $1;
                         $playlists->[$pl_idx]->{PlaylistID}   = $pl_id;
                         $playlists->[$pl_idx]->{Name}         = $self->decode_xml($pl_name);
                         $playlists->[$pl_idx]->{tracks}       = [] };
            m!<key>Track ID</key><integer>(\d+)</integer>!
                and do { warn $1 if $is_master; push @{ $playlists->[$pl_idx]->{tracks} }, $1 };
        } else {
            m!<key>Track ID</key><integer>(\d+)</integer>!
                and do { $curr_id = $1; $tracks->{$curr_id}->{TrackID} = $curr_id };
            m!<key>(Name|Artist|Kind|Size|Location)</key><string>(.*?)</string>!
                and $tracks->{$curr_id}->{$1} = $self->decode_xml($2);
            m!<key>(Track Type|Artwork Count)</key><(string|integer)>(.*?)</\2>!
                and do { my($key, $val) = ($1, $3); $key =~ tr/ //d; $tracks->{$curr_id}->{$key} = $val };
            m!<key>Playlists</key>!
                and $in_playlist = 1;
        }
    }

    $self->{file}      = $file;
    $self->{playlists} = $playlists;
    $self->{tracks}    = $tracks;
}

sub decode_xml {
    my($self, $string) = @_;
    $string =~ s/&#(\d\d);/chr($1)/eg; # &#36; -> &
    $string;
}

sub playlists {
    my $self = shift;
    sort { $a->PlaylistID <=> $b->PlaylistID } 
        map { iTunes::RSSServer::Playlist->new($_) } @{ $self->{playlists} };
}

sub find_playlist {
    my($self, $id) = @_;
    first { $_->PersistentID eq $id } $self->playlists;
}

package iTunes::RSSServer::Thing;
use vars qw( $AUTOLOAD );

sub new {
    my($class, $data) = @_;
    bless {%$data}, $class;
}

sub DESTROY { }

sub AUTOLOAD {
    my $self  = shift;
    $AUTOLOAD =~ s/.*:://g;
#    Carp::carp "field $AUTOLOAD is unknown on ", ref($self) unless exists $self->{$AUTOLOAD};
    return $self->{$AUTOLOAD};
}

package iTunes::RSSServer::Playlist;
use base qw( iTunes::RSSServer::Thing );

sub tracks {
    my $self = shift;
    map { my $data = $iTunesLibrary->{tracks}->{$_};
          $data && $data->{TrackType} eq 'File'
              ? iTunes::RSSServer::Track->new($data) : () }
        @{ $self->{tracks} };
}

sub find_track {
    my($self, $id) = @_;
    iTunes::RSSServer::Track->new($iTunesLibrary->{tracks}->{$id});
}

package iTunes::RSSServer::Track;
use base qw( iTunes::RSSServer::Thing );

use Encode;

use MP3::Tag;
use MP4::Info;

sub artwork {
    my $self = shift;
    if ($self->location_path =~ /\.m4[ab]$/) {
        my $info = MP4::Info->new($self->location_path) or return;
        return "image/jpeg", $info->{COVR};
    } else {
        my $info = MP3::Tag->new($self->location_path);
           $info->get_tags;
        if (my $id3 = $info->{ID3v2}) {
            my $pic = $id3->get_frame('APIC') || $id3->get_frame('PIC');
            if ($pic) {
                return $pic->{'MIME type'}, $pic->{_Data};
            }
        }
        return;
    }
}

sub has_artwork {
    my $self = shift;
    $self->ArtworkCount;
}

sub location_path {
    my $self = shift;

    # Location is an URI escaped string in UTF-8
    my $location = $self->Location;
    Encode::_utf8_off($location); 
    $location =~ s!^file://localhost/!/!; # keep / for Mac OSX
    $location =~ s!^/([A-Z]:)!$1!;        # remove / for Win32 
    $location =~ s!%([0-9a-fA-F]{2})!chr(hex($1))!eg;
    Encode::from_to($location, "UTF-8", $FileSystemEncoding);

    $location;
}

sub mime_type {
    my($self, $via_psp) = @_;

    my $ext = lc( ($self->Location =~ /\.(\w+)$/)[0] || "mp3" );
    if ($via_psp) {
        $ext = 'mp4' if $ext =~ /^m4[ab]$/; # hack to support PSP
    }
    my $media = $self->Kind =~ /(?:MPEG-4|QuickTime)/ ? "video" : "audio"; # xxx
    wantarray ? ($media, $ext) : "$media/$ext";
}

package main;
use Getopt::Long;
use Sys::Hostname;

my $encoding = $^O eq 'MSWin32' ? 'windows-31j' : 'UTF-8';
my %opt = (port => 8080, encoding => $encoding, title => hostname);
GetOptions(\%opt, "--port=i", "--encoding=s", "--library=s", "--server=s", "--title=s", "--bind=s", "--passwd=s");

$FileSystemEncoding = $opt{encoding};
$NetServerDriver    = $opt{server};

my $server = iTunes::RSSServer->new($opt{port});
$server->set_passwd($opt{passwd}) if $opt{passwd};
$server->host($opt{bind}) if $opt{bind};
$server->title($opt{title});
$server->load_library($opt{library});
$server->load_feed_icon();
$server->run;

package iTunes::RSSServer;
__DATA__
R0lGODlhDAAMAOYAAPSTPf3x5uOAPu6GOu6HOvabROuDOemOQuqPQuBpLOh7N+t+MuuAOfGMPOd2MPKPPOV2NvCLO+6FM/WWPuNvLvGKNOB7PeNyNfOPNvWVO/GxivzAg/mrXfrl2Peyde2aY/eZP/q4dvScT/q9g/ujRv7nzuVzLvu/g/uvX/jEmuOAU+yHPvnHmvS8mP3q2fOkZt9qMPmxav7z5u6mffu6d+FuNPq3dvO2i/SSPfuuXv3v5fCdZfaraOuAMfi5gf748uh5MOl+N/jFmvGVTdteKvGPOeZ6M/CNQN1jK/3w5veXOO+GNPaUN/7y5viYOPqbOfOONvjk1/udOv/58////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAAAAAAALAAAAAAMAAwAAAeNgFECQQYEEQ8AExkIgiYfKxIVGExOT1IHRkBUVEksBZVSSjgGPS9CLlRNOaFQDQQSKTxMIVNTHFBLAxEVm000KFMBRwsMDxgFJzJUNh5UNw4KAEwxGyRNAUs6HRQQE05TVCM+VDstVAkXIE8lPyJDVBozVCowCKxLCw4UCUhEFlEHijQYwEABhAs1/gUCADs=
