here it is. it is somewhat specialized but easily customizable if you know a little perl:
#!perl
use File::Find;
use IMDB::Film;
use IMDB::Persons;
use HTML::Entities;
use LWP::Simple;
use WWW::TV::Series;
use String::Similarity;
use Data::Dumper;
use Win32::GUI;
$_=shift;
$download_art=1 if (/-a/);
$search_internet=1 if ( $download_art || (/-i/) );
# configurable parameters.
$dirs_to_scan="x:/video,y:/video,z:/video,y:/MusicVideos"; # where to look for video
#$dirs_to_scan="x:/video"; # where to look for video
# icon search path
$icondir="z:/videoicons";
# place to store pictures of people
$ppldir="z:/videoicons/people";
#where to cache imdb data
$imdb_cache_dir="/tmp/";
# patterns which match movies
$movie_file_regexp="(video_ts\\.ifo)|(\\.avi)|(\\.wmv)|(\\.mov)|(\\.mpg)|(\\.ts)\$"; # filename patterns of video files
# patterns which might have multiple movies in the same directory
$multi_movie_file_regexp="(\.mpg)|(\.wmv)|(\.mov)|(\.avi)|(\.ts)\$"; # filename patterns of video files
# directory name transformations to perform
@transformations=(
"/movies/->/Movies/All Movies/"
);
# set sort priorities. Items are normally sorted alphabettically, but we can over-ride
$priority{"Movies"}=10;
$priority{"TV"}=5;
$priority{"Movies/Recently Added"}=10;
$priority{"Movies/All Movies"}=20;
$priority{"Movies/Genres"}=5;
$priority{"Movies/Highly Rated"}=4;
$priority{"Movies/Recommended"}=4;
$priority{"Movies/Collections"}=3;
# set default icon filenames for specific folders here
$boxart{"Movies"}="$icondir/filmreel.jpg";
$boxart{"Movies/All Movies"}="$icondir/filmreel.jpg";
$boxart{"Movies/Recently Added"}="$icondir/filmreelnew.jpg";
$boxart{"Movies/Genres"}="$icondir/comedy-tragedy.jpg";
$boxart{"Movies/Collections"}="$icondir/film-collection.jpg";
$boxart{"Movies/Directors"}="$icondir/directors-chair.jpg";
$boxart{"Movies/Cast"}="$icondir/cast.jpg";
$boxart{"Movies/Recommended"}="$icondir/thumb-up.jpg";
$boxart{"Movies/Highly Rated"}="$icondir/academy-award-statue.jpg";
$boxart{"TV"}="$icondir/television.jpg";
# auto-series title pattern matches - prevents you from having to add series.txt in metadata -
# just type it here
@autoseries=(
"batman->Comic Book Movies",
"spiderman->Comic Book Movies",
"godzilla->Giant Monsters",
"gojira->Giant Monsters",
"gamera->Giant Monsters",
);
# set thresholds (minimum # of matches) for supressing directories without enough entries
$children_required{"Movies/Directors"}=3;
$children_required{"Movies/Cast"}=3;
$children_required{"Movies/Genres"}=3;
$children_required{"Movies/Collections"}=1;
#end configurable parameters
open(XMLOUT,">movies.xml") || die "can't open output file";
print XMLOUT '<?xml version="1.0" encoding="utf-8"?>',"\n";
print XMLOUT "<database>\n <sortorder>sorttitle</sortorder>\n <template>movies</template>\n";
# print XMLOUT " <paths>\n";
# foreach(split(/,/,$dirs_to_scan))
# {
# s@/@\\@g;
# print XMLOUT " <path>$_</path>\n";
# }
# print XMLOUT " </paths>\n";
find(\&ProcessFile, split(/,/,$dirs_to_scan));
&output_db;
print XMLOUT "</database>\n";
close XMLOUT;
# sned message to xlobby if it is running
$whandle=Win32::GUI::FindWindow("","xlobby");
if ($ whandle )
{
Win32::GUI::SendMessage($whandle,WM_COMMAND,55555,12345);
}
sub ProcessFile
{
local($_) = $File::Find::name;
if (/ehth/)
{
print "what?";
}
$foldername = $_;
return if (/metadata/);
if ( -d $_ )
{
$basedir=$_;
foreach $base (split(/,/,$dirs_to_scan))
{
$foldername=~s@^$base/@@i;
}
if ( -e "$_/folder.jpg" )
{
$boxart{$foldername}="$basedir/folder.jpg";
}
else
{
# print "folder.jpg not found for $foldername\n";
}
}
elsif ( (m@$movie_file_regexp@i) )
{
# determined the desired folder for this item.
if (m@$multi_movie_file_regexp@i)
{
$n_videos_in_same_dir=0;
opendir(DIR, ".") || die "cant open dir $_";
foreach $f (readdir(DIR))
{
if ( $f =~/$movie_file_regexp/i)
{
$n_videos_in_same_dir++;
}
}
closedir DIR;
}
else
{
$n_videos_in_same_dir = 1;
}
$foldername =~ s@/([^/]*)$@@;
$basedir=$foldername;
# print "\r$basedir ";
foreach $mapping ( @transformations )
{
($srcpattern,$destpattern)=split(/\-\>/,$mapping);
$foldername=~ s@$srcpattern@$destpattern@i;
}
$foldername =~ s@/([^/]*)$@@ if ($n_videos_in_same_dir < 2 );
$title=$1;
foreach $base (split(/,/,$dirs_to_scan))
{
$foldername=~s@^$base/@@i;
}
$d=&createfolders($foldername);
# print "$_ goes in folder $foldername with label $title depth $d\n";
$nodename="$foldername/$title";
$parent{$nodename}=$foldername;
$depth{$nodename}=$d;
$disptitle{$nodename}=$title;
$nodename="$foldername/$title";
$path{$nodename}=$_;
&fetchboxart($basedir,$title) if ($download_art);
if ( -e "$basedir/folder.jpg" )
{
$boxart{$nodename}="$basedir/folder.jpg";
}
else
{
# print "no box art found for $_ in $basedir\n";
}
&scan_internet($basedir,$title) if ( $search_internet );
# now, scan meta data
if (opendir( METADATA,"$basedir/metadata" ))
{
foreach $meta_item (readdir(METADATA))
{
my $fname="$basedir/metadata/$meta_item";
unless( -d $fname )
{
open( ITEM,$fname) || die "can't open $fname";
$tag=$meta_item;
$tag=~s/\..*$//;
$tag=~tr/A-Z/a-z/;
my $data=<ITEM>;
# Convert < > & " to 'html' special characters.
$data =~s/\n$//g;
$metadata{$nodename}->{$tag}=$data;
close ITEM;
}
}
closedir METADATA;
}
# now, clone this item into other virtual directories
if ($nodename=~m@Movies/@)
{
# add to genre
my $genre=$metadata{$nodename}->{"genre"};
foreach $g (split(/,/,$genre))
{
$priority{"Movies/$g"}=5;
&clone_item($nodename,"Movies/Genres/$g/$title");
if (-e "$icondir/$g.jpg")
{
$boxart{"Movies/Genres/$g"}="$icondir/$g.jpg";
}
}
# add to director
my $director=$metadata{$nodename}->{"directors"};
foreach $g (split(/,/,$director))
{
&clone_item($nodename,"Movies/Directors/$g/$title");
$boxart{"Movies/Directors/$g"}="$ppldir/$g.jpg";
}
# add to cast
my $cast=$metadata{$nodename}->{"cast"};
foreach $g (split(/,/,$cast))
{
&clone_item($nodename,"Movies/Cast/$g/$title");
$boxart{"Movies/Cast/$g"}="$ppldir/$g.jpg";
}
# add to collections
my $collections=$metadata{$nodename}->{"collection"};
foreach $collection (split(/,/,$collections))
{
# print STDERR "add $nodename to collection $collection\n";
&clone_item($nodename,"Movies/Collections/$collection/$title");
if (-e "$icondir/$collection.jpg")
{
$boxart{"Movies/Collections/$collection"}="$icondir/$collection.jpg";
}
}
# add hd movies to hd collection
&clone_item($nodename,"Movies/HD Movies/$title")
if (
( $path{$nodename} =~ /\.ts$/i) ||
( $path{$nodename} =~ /\.720p/i) ||
( $path{$nodename} =~ /\.1080[pi]/i) );
my $year=$metadata{$nodename}->{"year"};
foreach $ytest ("193","194","195","196","197","198","199","200")
{
if ( $year =~ /^$ytest\d/)
{
&clone_item($nodename,"Movies/Collections/$ytest"."0s/$title");
}
}
foreach $auto (@autoseries)
{
my ($match, $rslt)=split(/\-\>/,$auto);
if ( $title=~/$match/i)
{
# print STDERR "add $title to collection $rslt\n";
&clone_item($nodename,"Movies/Collections/$rslt/$title");
if (-e "$icondir/$rslt.jpg")
{
$boxart{"Movies/Collections/$rslt"}="$icondir/$rslt.jpg";
}
}
}
# add to recently added
&clone_item($nodename,"Movies/Recently Added/$title") if ( (-M $_)<15 );
# add to recommended
&clone_item($nodename,"Movies/Recommended/$title") if ( $metadata{$nodename}->{"rating"} > 7.5);
# add to highly rated
&clone_item($nodename,"Movies/Highly Rated/$title") if ( $metadata{$nodename}->{"rating"} > 8.1);
}
}
}
sub clone_item
{
local($orig_node, $new_node)=@_;
unless ( $depth{$new_node} )
{
$path{$new_node}=$path{$orig_node};
$boxart{$new_node}=$boxart{$orig_node};
$disptitle{$new_node}=$disptitle{$orig_node};
$metadata{$new_node}=$metadata{$orig_node};
my $par=$new_node;
$par =~ s@/([^/]*)$@@;
$parent{$new_node}=$par;
$nchildren{$par}++;
$d=&createfolders($par);
$depth{$new_node}=$d;
}
}
sub createfolders
{
local ($_) = @_;
my $depth1 = 1;
my $nodename="";
foreach $node (split(/\//,$_))
{
my $parent=$nodename;
$nodename.="/" if ( $depth1>1);
$nodename.=$node;
unless ( $depth{$nodename} )
{
$parent{$nodename}=$parent;
$nchildren{$parent}++;
$depth{$nodename}=$depth1;
$isfolder{$nodename}=1;
$disptitle{$nodename}=$node;
# print "create parent $nodename\n";
}
$depth1++;
}
return$depth1++;
}
sub output_item
{
local($_)=@_;
unless ($already_output{$_})
{
$base_boxart=$boxart{$_} if ( length( $boxart{$_} ) );
local $indent=" " x (2*( ($depth{$_})));
$already_output{$_}=1;
print XMLOUT $indent,"<item>\n";
$cv=$base_boxart;
if (length($cv))
{
if ($cv =~ m@^$ppldir/(.*)\.jpg$@i)
{
&fetchportrait(0,$1) if ($download_art);
}
if (-e $cv )
{
$cv=~s@/@\\@g;
print XMLOUT $indent," <coverart>$cv</coverart>\n";
}
else
{
print "$cv does not exist\n";
}
}
else
{
# print STDERR "No cover art for $_ ($path{$_})\n";
}
print XMLOUT $indent," <display>",encode_entities($disptitle{$_}),"</display>\n";
if ($isfolder{$_})
{
print XMLOUT $indent," <parameter>",encode_entities($_),"</parameter>\n";
print XMLOUT $indent," <type>folder</type>\n";
# now, output children
print XMLOUT $indent," <subitems>\n";
my $ournode=$_;
my @children=grep {$parent{$_} eq $ournode} (keys %depth);
foreach $node (sort bypriority_and_name @children)
{
# print "node $node nchildren=$nchildren{$node} thres $children_required{$ournode} ($ournode)\n";
if ($nchildren{$node} >= $children_required{$ournode} )
{
my $save_base=$base_boxart;
output_item($node);
$base_boxart = $save_base;
}
}
print XMLOUT $indent,"</subitems>\n";
}
else
{
print XMLOUT $indent," <parameter>",encode_entities($path{$_}),"</parameter>\n";
print XMLOUT $indent," <type>movie</type>\n";
print XMLOUT $indent," <information>\n";
my $genres=$metadata{$_}->{"genre"};
# add spaces for word wrapping
$genres=~s/,([^ ])/, \1/g;
print XMLOUT $indent," <genre>",$genres,"</genre>\n";
print XMLOUT $indent," <rating>",$metadata{$_}->{"rating"},"</rating>\n";
print XMLOUT $indent," <year>",$metadata{$_}->{"year"},"</year>\n";
print XMLOUT $indent," <tagline>",encode_entities($metadata{$_}->{"tagline"}),"</tagline>\n";
print XMLOUT $indent," <plot>",&getsummary($_),"</plot>\n";
print XMLOUT $indent," </information>\n";
}
print XMLOUT $indent,"</item>\n";
}
}
sub getsummary
{
local($_)=@_;
my $ret=$metadata{$_}->{"tagline"};
$ret.="\n\n".$metadata{$_}->{"plot"};
$ret.="\n\nIMDB Rating:".$metadata{$_}->{"rating"};
$ret.="\n\nDirected by:".$metadata{$_}->{"directors"};
$ret.="\nStarring:".join(", ",split(/,/,$metadata{$_}->{"cast"}));
return encode_entities($ret);
}
sub bypriority_and_name
{
if ($priority{$a} != $priority{$b})
{
return $priority{$b} <=> $priority{$a};
}
return $disptitle{$a} cmp $disptitle{$b};
}
sub output_db
{
foreach $_ ( sort bypriority_and_name keys %depth )
{
&output_item($_) if ($depth{$_} == 1 );
}
}
sub update_using_tvdotcom
{
my ($dirname,$title)=@_;
my $show, $epname;
my $showid="";
if ( (
( $dirname=~m@(^.*/TV/cartoons/)([^/]*).*$@i ) ||
( $dirname=~m@(^.*/TV/cartoons/)([^/]*)/.*$@i ) ||
( $dirname=~m@(^.*/TV/)([^/]*)/.*$@i )
))
{
$show_root_dir="$1$2";
$show=$2;
if ( -e "$show_root_dir/show_id.txt" )
{
open (SHOW_ID_FILE,"$show_root_dir/show_id.txt" ) || die "cant open id file";
my $filein=<SHOW_ID_FILE>;
if ( $filein=~/^(\d+)/ )
{
$show_id{lc($show)}=$1;
}
close SHOW_ID_FILE;
}
}
else
{
print STDERR "dont' know show for $dirname\n";
return;
}
if ( ( $dirname=~m@TV/$show/season \d+/(.*$)@i ) ||
( $dirname=~m@TV/cartoons/$show/(.*$)@i ) ||
( $dirname=~m@TV/$show/(.*$)@i ) )
{
$epname=$1;
}
else
{
print "can't determine episode name for $dirname $show\n";
return;
}
unless(
( -e "$dirname/metadata/genre.txt" ) &&
( -e "$dirname/metadata/plot.txt" ) &&
( -e "$dirname/metadata/cast.txt" )
)
{
print stderr "Looking up data for episode $epname of show $show\n";
eval
{
unless ( $curshowname eq $show )
{
if ( length( $show_id{lc($show)} ) )
{
print "open show $show by id\n";
$curshow=WWW::TV::Series->new(id => $show_id{lc($show)});
}
else
{
$curshow=WWW::TV::Series->new(name => $show);
}
}
else
{
print "*cache hit on $show\n";
}
$curshowname=$show;
&writemeta($dirname,"genre",$curshow->genres);
my $best_match=0;
my $epmatch;
foreach $ep ( $curshow->episodes)
{
my $test_sim=similarity lc($epname),lc($ep->name);
if ($test_sim > $best_match)
{
$best_match = $test_sim;
$epmatch=$ep;
}
}
if ( $best_id != -1 )
{
print "best match for $epname is ",$epmatch->name,"\n";
print $epmatch->summary;
&writemeta($dirname,"plot",$epmatch->summary);
&writemeta($dirname,"cast",$epmatch->stars);
&writemeta($dirname,"guest stars",$epmatch->guest_stars);
}
else
{
print "episode $epname not found\n";
}
};
if ($@)
{
print "error processing series $show\n";
undef $curshow;
undef $curshowname;
return;
}
}
}
sub scan_internet
{
my ($dirname,$title)=@_;
if (! ( -e "$dirname/metadata" ))
{
print STDERR "creating meta data dir for $dirname\n";
mkdir("$dirname/metadata",0755);
}
if ($dirname=~m@/TV/@i)
{
&update_using_tvdotcom( $dirname, $title );
}
elsif ($dirname=~m@/Movies/@i)
{
&update_using_imdb( $dirname, $title );
}
}
sub update_using_imdb
{
my ($dirname,$title)=@_;
unless(
( -e "$dirname/metadata/genre.txt" ) &&
( -e "$dirname/metadata/plot.txt" ) &&
( -e "$dirname/metadata/year.txt" ) &&
( -e "$dirname/metadata/directors.txt" ) &&
( -e "$dirname/metadata/rating.txt" ) &&
( -e "$dirname/metadata/duration.txt" ) &&
( -e "$dirname/metadata/cast.txt" ) &&
( -e "$dirname/metadata/tagline.txt" )
)
{
print "searching imdb for $title\n";
my $crit = $title;
if (-e "$dirname/imdb_id.txt")
{
if ( open( IMDB_ID, "$dirname/imdb_id.txt"))
{
$crit=int(<IMDB_ID>);
close IMDB_ID;
}
}
my $imdbobj=new IMDB::Film(crit => $crit,
cache => 1,
cache_root => $imdb_cache_dir,
cache_exp => '1 d'
);
if($imdbobj->status)
{
&writemeta($dirname,"genre",join(",",@{ $imdbobj->genres()}));
&writemeta($dirname,"plot",$imdbobj->plot());
&writemeta($dirname,"rating",$imdbobj->rating());
&writemeta($dirname,"year",$imdbobj->year());
&writemeta($dirname,"duration",$imdbobj->duration());
&writemeta($dirname,"tagline",$imdbobj->tagline());
my @dirlist;
my $directors=$imdbobj->directors();
for(@$directors) {
my($id, $dirname) = each %$_;
unless ($dirname=~/IMG/)
{
unless( $dirname =~ m@\(more@i )
{
push @dirlist,$dirname;
# &fetchportrait($dirname,$id);
}
}
}
&writemeta($dirname,"directors",join(",",@dirlist));
my @castlist;
my $cast=$imdbobj->cast();
for(@$cast) {
my($id, $name, $role) = each %$_;
unless ($name=~/IMG/)
{
unless( $name =~ m@\(more@i )
{
push @castlist,$name;
# &fetchportrait($name,$id);
}
}
}
&writemeta($dirname,"cast",join(",",@castlist));
}
else
{
print "Problem in IMDB lookup for $title\: ".$imdbobj->error,"\n";
}
}
}
sub fetchportrait
{
my ($pplid, $pname)=@_;
unless (-e "$ppldir/$pname.jpg" )
{
print "fetcjhing data for $pname from imdb\n";
my $person = new IMDB::Persons(crit => $pname,
cache => 1,
cache_root => $imdb_cache_dir,
cache_exp => '1 d'
);
if($person->status)
{
my $purl=$person->photo();
if (length($purl))
{
my $jpg=get($purl);
open(POUT,">$ppldir/$pname.jpg") || die "cant open $ppldir/$pname.jpg";
binmode POUT;
print POUT $jpg;
close POUT;
}
}
else
{
print "Something wrong: ".$person->error."!\n";
}
}
}
sub fetchboxart
{
my ($destdir,$title)=@_;
unless (-e "$destdir/folder.jpg" )
{
return if ($destdir =~ m@/tv/@i);
return if ($destdir =~ m@/musicvideos/@i);
print "trying to download box art from imdb for $title $destdir\n";
my $imdbobj=new IMDB::Film(crit => $title,
cache => 1,
cache_root => $imdb_cache_dir,
cache_exp => '1 d'
);
if($imdbobj->status)
{
my $purl=$imdbobj->cover();
if (length($purl))
{
my $jpg=get($purl);
open(POUT,">$destdir/folder.jpg") || die "cant open img output";
binmode POUT;
print POUT $jpg;
close POUT;
}
}
else
{
print "Something wrong: ".$imdbobj->error."!\n";
}
}
}
sub writemeta
{
my ($dir,$tag,$value)=@_;
unless( -e "$dir/metadata/$tag.txt" )
{
open(METAOUT,">$dir/metadata/$tag.txt") || die;
print METAOUT $value;
close METAOUT;
}
}