Mumbling Again

joshua% eyetvlinks.pl -s

/usr/local/bin/eyetvlinks.pl -pl | logger

#!/usr/bin/perl -w

# EyeTvLinks 1.2
#
# Search recursively through the EyeTV Archive and make some
# friendly links in my shared video directory for the roommates.
#
# Copyright 2005 Joshua McFarren. Some rights reserved.
# This work is licensed under a Creative Commons License:
# http://creativecommons.org/licenses/by-sa/2.0/

my $archive_dir = "/Volumes/Seagate 200/EyeTV Archive";
my $link_dir    = "/Volumes/Seagate 200/Video/EyeTV";
my $separator   = "  ";

### SCRIPT ###

use strict;
use Getopt::Std;
my $script_name = &pluck($0);
my $version     = '1.2';
my %opts;
&print_usage() && exit unless getopts('slp', \%opts);

opendir(ARCHIVE, $archive_dir) or die "ERROR! Couldn't open $archive_dir: $!\n";
my @dirs = grep { !/^(f{16}|\.)/ } grep { -d "$archive_dir/$_" } readdir(ARCHIVE);
closedir(ARCHIVE);

my %shows = ();
foreach my $show_code (@dirs) {

    my $title = '';
    my $subdir = "$archive_dir/$show_code";

    opendir(SUBDIR, $subdir ) or die "ERROR! Couldn't open $subdir: $!\n";
    my @files = grep { s/.mpg// } grep { /.mpg/ } readdir(SUBDIR);
    closedir(SUBDIR);

    if (@files) {
        my $slurp = &slurp_file("$subdir/$show_code" . ".eyetvp");
        if ( $slurp =~ m#<key>title</key>\s+<string>([^<]+)</string>#i ) {
            $title = $1;
            $title =~ s#\s*(/|:)\s*# - #g;
        } else { print STDERR "ERROR! Bad XML found in $subdir/$show_code", ".eyetvp\n"; }
    } else { next; } # no mpgs recorded yet move on

    my %recordings = (); # reset list of recordings for each show
    foreach my $recording_code (@files) {
        my $slurp = &slurp_file("$subdir/$recording_code" . ".eyetvr");
        if ( $slurp =~ m#<key>start</key>\s+<date>(\d{4}-\d{2}-\d{2})[^<]*</date>#i ) {
            # for readablity, we could push $1 instead
            my $date = $1;
            # hash of recordings for active show
            $recordings{$recording_code} = $date;
        } else { next; }
    } # next recording

    # store a reference to it in the hash of shows
    $shows{$show_code} = { 'title' => $title, 'recordings' => \%recordings };

} # next show

if (! %opts) {
    &print_usage("$script_name version $version");
} else {
    if ( $opts{'l'} || $opts{'s'} ) {
        &clear_dir();
        &make_links();
    }
    if ( $opts{'p'} ) { &print_info(); }
}

### SUBS ###

sub clear_dir {
    opendir(LINKDIR, $link_dir) or die "ERROR! Couldn't open $link_dir: $!\n";
    my @links = map { "$link_dir/$_" } grep { /.mpg/ } readdir(LINKDIR);
    closedir(LINKDIR);
    foreach my $link (@links) {
        unlink ($link) or warn "ERROR! Couldn't unlink file: $!\n$link\n";
    }
}

sub make_links {
    foreach my $show_code (keys %shows) {
        # pull out the reference we stored earlier
        my $showref = $shows{$show_code}->{'recordings'};
        foreach my $recording_code (keys %$showref){
            my $source = "$archive_dir/$show_code/$recording_code" . ".mpg";
            my $target  = "$link_dir/" . $shows{$show_code}->{'title'} . " - ";
               $target .=  $shows{$show_code}->{'recordings'}->{$recording_code} . ".mpg";
            if ($opts{'s'}) {
                my $episode_num = 2;
                while (-e $target ) {
                    $target =~ s#(\d{4}-\d{2}-\d{2})( - \d+)?(.mpg)#$1 - $episode_num$3#i;
                    $episode_num++;
                }
                symlink $source, $target or warn "\nERROR! $!\n$source\n$target\n";
            } else {
                my $episode_num = 2;
                while (-e $target ) {
                    $target =~ s#(\d{4}-\d{2}-\d{2})( - \d+)?(.mpg)#$1 - $episode_num$3#i;
                    $episode_num++;
                }
                link $source, $target or warn "\nERROR! $!\n$source\n$target\n";
            }
        }
    }
}

sub print_info {
    foreach my $show_code (keys %shows) {
        print "\n";
        print $shows{$show_code}->{'title'}, "\n";
        # pull out the reference we stored earlier
        my $showref = $shows{$show_code}->{'recordings'};
        foreach my $recording_code (keys %$showref){
            print $separator, $shows{$show_code}->{'recordings'}->{$recording_code};
            print $separator, "$show_code/$recording_code", ".mpg\n";
        }
    }
}

sub slurp_file {
    my $path = shift;
    my $contents = '';
    open (INFILE, "< $path") or die "ERROR! Can't open $path: $!\n";
    while (<INFILE>) { $contents .= $_; }
    close INFILE;
    return $contents;
}

sub pluck {
    my @path = split ('/', "$_[0]");
    return pop @path;
}

sub print_usage {
if ($_[0]){ print STDERR "$_[0]\n"; }
print STDERR <<EOF;
Usage: $script_name [OPTIONS]
    options:
    -s  create symbolic links
    -l  create hard links
    -p  print information about recordings
EOF
}

__END__

HISTORY:

1.2   April 22, 2005 - Ported script to perl. No more backticks, no more
      sed or awk. Huge performance increase. Rewritten from the ground up
      with nested hash data structure. Fixed bug where two recordings of
      the same program on the same day replace each other. (Thanks Jan!)
      Supports command line switches. Better reporting with -p switch.

1.1b  February 15, 2005 - Added support for multiple recordings of same
      program on different days by adding date to the link name. Removed
      useless uses of echo and cat.

1.0b  May 5, 2004 - Rough cut.

TO DO:

   *  Put description in the finders get info field?

   *  Add support for locating the EyeTV archive automatically?
      Chris Nandor did this, but you need to install modules for it to
      work. I would like to keep this simple to install and run for
      people who have little cli experience. Perhaps just check for the
      prefs in the obvious places.

   *  Add support for specifying the link_dir with a switch

DISTRIBUTION:

This script and it's documentation can be found here:
http://www.mcfarren.org/archives/000030.html

This work is licensed under a Creative Commons License:
http://creativecommons.org/licenses/by-sa/2.0/