manage_playlists

#!/usr/bin/perl

####################################################
#
# managae_playlists - create and synchronize playlists to Mass Storage
#                     Device type players, SD cards, USB sticks, etc.
#
# Copyright (C) 2014 Matthew Caron <matt@mattcaron.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License, version 2, as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# Full license at: http://www.fsf.org/licensing/licenses/info/GPLv2.html
#
####################################################

use strict;
use warnings;
use diagnostics;

use File::Spec;
use File::Path;
use File::Copy;
use Getopt::Long;
use Data::Dumper;

## Constants

my $PLAYLIST_PREFIX = "";
my $PLAYLIST_SUFFIX = ".m3u";

# Filter to be passed to the shell's find in order to find files
my $FIND_FILTER = "-type f -name '*.mp3' -or -name '*.ogg' -or -name '*.wav' -or -name '*.opus'";
# (We're not going to test that you have this, because everyone does.
my $FIND = `which find`;
chomp($FIND);

my $opusinfo = `which opusinfo`;
chomp($opusinfo);
if (!defined($opusinfo) || length($opusinfo) == 0) {
    printf("Warning - opusinfo not found, EXTINF entries " . 
           "for opus files won't be possible\n\n");
    $opusinfo = undef;
}

my $ogginfo = `which ogginfo`;
chomp($ogginfo);
if (!defined($ogginfo) || length($ogginfo) == 0) {
    printf("Warning - ogginfo not found, EXTINF entries " . 
           "for ogg files won't be possible\n\n");
    $ogginfo = undef;
}

my $mp3info = `which mp3info`;
chomp($mp3info);
if (!defined($mp3info) || length($mp3info) == 0) {
    printf("Warning - mp3info not found, EXTINF entries " . 
           "for mp3 files won't be possible\n\n");
    $mp3info = undef;
}

## END CONSTANTS

##
# Normalize the playlist name
#
# This allows the use of shortnames, e.g. "blues", and makes sure they
# have the proper prefix and suffix.
#
# This automatically discards 
#
# @param name Name to be normalized
#
# @return The normalized name
sub normalizePlaylist($)
{
    my ($playlist) = @_;

    if ($playlist !~ /^$PLAYLIST_PREFIX/) {
        $playlist = $PLAYLIST_PREFIX . $playlist;
    }

    if ($playlist !~ /$PLAYLIST_SUFFIX$/) {
        $playlist = $playlist . $PLAYLIST_SUFFIX;
    }

    return $playlist;
}

##
# Calculate the runtime in seconds.
#
# This converts playlist lengths of things like XXm:YY.YYYYs to an
# integer number of seconds. Decimal seconds are truncated.
#
# @param runtime The runtime string in the above format.
#
# @return The runtime in seconds
#
sub calculatRuntimeSeconds($)
{
    my ($runtime) = @_;

    my $minutes = 0;
    my $seconds = 0;

    # replace all leading and trailing whitespace (aka trim())
    $runtime =~ s/^\s+//;
    $runtime =~ s/\s+$//;

    # Short audio files may or may not have a minutes entry
    if ($runtime =~ /^(\d+)m/) {
        $minutes = $1;
        $minutes *= 60;
    }
    
    # We drop the decimal seconds here. We don't care.
    $runtime =~ /(\d+).\d+s$/;
    $seconds = $1;

    return $minutes + $seconds;
}

##
# Get the EXTINF line for an opus file
#
# @param file File for which we should get info
#
# @return EXTINF line suitable for printing to file (including
# trailing newline)
#
sub getOpusEXTINFLine($)
{
    my ($file) = @_;
    my $extinf = "";

    if (!defined(open(INFO, "-|", "${opusinfo} \"${file}\""))) {
        print("Warning - unable to get info for ${file}: $!\n");
    }
    else {
        my $runtime = "";
        my $artist = "";
        my $title = "";
        while (my $line = <INFO>) {
            chomp($line);
            if ($line =~ /^\s+TITLE=(.*)$/) {
                $title = $1;
            }
            elsif ($line =~ /^\s+ARTIST=(.*)$/) {
                $artist = $1;
            }
            elsif ($line =~ /Playback length:(.*)$/) {
                $runtime = calculatRuntimeSeconds($1);
            }
        }
        $extinf = "#EXTINF:${runtime},${artist} - ${title}\n";
    }

    return $extinf;
}

##
# Get the EXTINF line for an ogg file
#
# @param file File for which we should get info
#
# @return EXTINF line suitable for printing to file (including
# trailing newline)
#
sub getOggEXTINFLine($)
{
    my ($file) = @_;
    my $extinf = "";

    if (!defined(open(INFO, "-|", "${ogginfo} \"${file}\""))) {
        print("Warning - unable to get info for ${file}: $!\n");
    }
    else {
        my $runtime = "";
        my $artist = "";
        my $title = "";
        while (my $line = <INFO>) {
            chomp($line);
            if ($line =~ /^\s+TITLE=(.*)$/) {
                $title = $1;
            }
            elsif ($line =~ /^\s+ARTIST=(.*)$/) {
                $artist = $1;
            }
            elsif ($line =~ /Playback length:(.*)$/) {
                $runtime = calculatRuntimeSeconds($1);
            }
        }
        $extinf = "#EXTINF:${runtime},${artist} - ${title}\n";
    }

    return $extinf;
}

##
# Get the EXTINF line for an MP3 file
#
# @param file File for which we should get info
#
# @return EXTINF line suitable for printing to file (including
# trailing newline)
#
sub getMP3EXTINFLine($)
{
    my ($file) = @_;

    return "#EXTINF:" . `${mp3info} -p "%S,%a - %t" "${file}"` . "\n";
}


##
# Add to a playlist, optionally overwriting the playlist
#
# @param overwrite 1 to overwrite playlist, 0 to not.
# @param verbose 1 to be verbose.
# @param normalize 1 to normalize the playlist name.
# @param extinf 1 to generate extinf.
#
# @return 0 on success
# @return a count of the failures on error
#
sub add($$$$)
{
    my ($overwrite, $verbose, $normalize, $extinf) = @_;

    my $retval = 1;
    my $failCount = 0;

    my $op = ">>";
    
    if ($overwrite) {
        $op = ">";
    }

    my $playlist = shift(@ARGV);

    # if the playlist has any slashes in it, then someone didn't read
    # the instructions
    if ($playlist =~ /\//) {
        print("Playlists must be in the current directory\n");
    }
    else {

        if ($normalize) {
            $playlist = normalizePlaylist($playlist);
        }
        
        if (!defined(open(PLAYLIST, $op, $playlist))) {
            print("Can't open ${playlist}: $!\n");
        }
        else {
            foreach my $directory (@ARGV) {
                if ($verbose) {
                    print("Adding files from ${directory}\n");
                }
                
                if (!defined(open(FIND, "-|", 
                                  "${FIND} ${directory} ${FIND_FILTER}"))) {
                    print("Can't add ${directory}: $!\n");
                    ++$failCount;
                }

                if ($extinf) {
                    print(PLAYLIST "#EXTM3U\n");
                }

                while (<FIND>) {
                    my $line = $_;
                    chomp($line);

                    if ($extinf) {
                        if ($line =~ /.opus$/i) {
                            if (defined($opusinfo)) {
                                print(PLAYLIST getOpusEXTINFLine($line));
                            }
                        }
                        elsif ($line =~ /.ogg$/i) {
                            if (defined($ogginfo)) {
                                print(PLAYLIST getOggEXTINFLine($line));
                            }
                        }
                        elsif ($line =~ /.mp3$/i) {
                            if (defined($mp3info)) {
                                print(PLAYLIST getMP3EXTINFLine($line));
                            }
                        }
                        elsif ($verbose) {
                            # else it's some other file format which we
                            # don't know, but only say something if we
                            # want verbose
                            printf("Unknown file extension for:\n " .
                                   "    ${line}\n");
                        }
                    }
                        
                    print(PLAYLIST "${line}\n");
                    if ($verbose) {
                        print("${line}\n");
                    }
                }
                close(FIND);
            }
            
            close(PLAYLIST);

            $retval = $failCount;
        }
    }
    
    return $retval;
}

##
# Resolve the destination to an appropriate absolute path
#
# This takes the destination and:
# 1. If it is an absolute path, return it
# 2. If it is not an absolute path, but the part before the first /
#    matches the last part of a filesystem as returned by mount,
#    construct an absolute path from these data points.
# 3. Else, it must be a relative path, just use it.
#
# This logic basically simplifies to:
#
# If it's an absolute path or not part of a mounted string, just use
# it.
#
# @param destination Destination to be resolved.
# @param verbose Whether or not it should be verbose.
#
# @return A resolved destination (absolute path).
#
sub resolveDestination($$)
{
    my ($destination, $verbose) = @_;

    my $resolved = $destination;

    if ($destination !~ /^\//) {
        my @parts = split("/", $destination);
        my $match = join("/", @parts[0..$#parts-1]);

        if ($verbose) {
            print("Looking for mount points matching ${match}.\n");
        }

        if (!defined(open(MOUNT, "-|", "mount"))) {
            print("WARNING: Unable to open mount command: $!\n");
        }
        else {
            my $done = 0;
            while (defined(my $line = <MOUNT>) && !$done) {
                $line =~ /^.* on (.*) type .*$/;
                my $mount = $1;

                if ($mount =~ /\Q$match\E$/) {
                    if ($verbose) {
                        print("Found matching mount point ${mount}.\n");
                    }
                    $done = 1;
                    $destination =~ s/^\Q$match\E/$mount/;
                    $resolved = $destination;
                }
            }

            if (!$done && $verbose) {
                print("Didn't find a matching mount point, " . 
                      "assuming relative path\n");
            }
        }
        
    }

    return $resolved;
}



##
# Push files dictated by playlists, and the playlists to a destination
#
# This won't copy files that exist, unless force is specified.
#
# This is called sync because push is a builtin array op.
#
# @param force 1 to always copy files, even if they exist.
# @param verbose 1 to be verbose.
# @param normalize 1 to normalize the playlist name.
#
# @return 0 on success
# @return a count of the failures on error
#
sub sync($$$)
{
    my ($force, $verbose, $normalize) = @_;
    my $failCount = 0;

    my $destination = shift(@ARGV);

    $destination = resolveDestination($destination, $verbose);

    foreach my $playlist (@ARGV){
        if ($normalize) {
            $playlist = normalizePlaylist($playlist);
        }

        if ($verbose) {
            print("Transferring files listed in ${playlist}\n");
        }

        # Make sure the overall destination directory exists
        if (!-d $destination) {
            if ($verbose) {
                print("\nMaking directory ${destination}...\n");
            }
            
            if (!mkpath($destination)) {
                print("Cannot mkpath ${destination}: $!\n");
                ++$failCount;
            }
        }

        # if it still doesn't exist, we have an error, don't copy anything
        if (-d $destination) {
            if (!defined(open(PLAYLIST, "<", $playlist))) {
                print("Unable to open ${playlist}: $!\n");
                ++$failCount;
            }
            else {
                # copy the playlist file
                my $playlist_destination = $destination . "/" . $playlist;
                if (!copy($playlist, $playlist_destination)) {
                    print("WARNING: Couldn't copy ${playlist} to " .
                          "${playlist_destination}: $!\n");
                    ++$failCount
                }
                
                while (my $line = <PLAYLIST>) {
                    if ($line =~ /^#/) {
                        # don't process comments, they are uncopyable
                    }
                    else {
                        my $source_file = $line;
                        chomp($source_file);
                        my $destination_file = $destination . "/" . 
                          $source_file;
                        my ($volume, $destination_dir, $file) =
                          File::Spec->splitpath($destination_file);
                        if (!-d $destination_dir) {
                            if ($verbose) {
                                print("\nMaking directory " . 
                                      "${destination_dir}...\n");
                            }
                            
                            if (!mkpath($destination_dir)) {
                                print("Cannot mkpath ${destination_dir}: $!\n");
                                ++$failCount;
                            }
                        }
                        
                        # Only transfer if we made the directory (above)
                        # or it already existed.
                        if (-d $destination_dir) {
                            # quick check - only copy the file if it
                            # doesn't exist (easy, cheap optimization
                            # step)
                            if (-e $destination_file && !$force) {
                                if ($verbose) {
                                    print("Skipping copy of " . 
                                          "${source_file}: \n" .
                                          "        ${destination_file} " . 
                                          "already exists\n");
                                }
                            }
                            else {
                                if ($verbose) {
                                    print("${source_file} => " . 
                                          "${destination_file}\n");
                                }
                                
                                # copy file to that directory
                                if (!copy($source_file, $destination_file)) {
                                    print("WARNING: Couldn't copy " . 
                                          "${source_file} to " .
                                          "${destination_file}: $!\n");
                                    ++$failCount;
                                }
                            }
                        }
                    }
                }
            }
        }
        close(PLAYLIST);
    }
   return $failCount;
}

##
#
sub main()
{
    my $help = 0;
    my $force = 0;
    my $verbose = 0;
    my $push = 0;
    my $add = 0;
    my $new = 0;
    my $opcount = 0;
    my $normalize = 0;
    my $extinf = 0;
    my $retVal = 1;

    my $options = GetOptions(
        "help|?"        => \$help,
        "force"         => \$force,
        "verbose"       => \$verbose,
        "push"          => \$push,
        "add"           => \$add,
        "new"           => \$new,
        "no-normalize"  => \$normalize,
        "no-extinf"     => \$extinf
        );

    # Normalize and extinf are inverted from their commands
    $normalize = !$normalize;
    $extinf = !$extinf;

    my ($volume, $dir, $command) = File::Spec->splitpath($0);

    my $usage   = qq^
${command} --push [options] destination playlist1 [playlist2...]
${command} --add [options] playlist directory1 [directory2...]
${command} --new [options] playlist directory1 [directory2...]

Commands are:
  --push       Push the listed playlists to destination.
  --add        Add the listed directories to playlist.
  --new        Like add, but deletes the playlist first.

Options are:
  --help, --?    displays this help
  --force        force copy, even if target exists (push only)
  --verbose      be more verbose
  --no-normalize don't normalize playlist names
  --no-extinf    don't generate EXTINF entries (which can take awhile,
                 especially for ogg)

Notes:
 1. Playlists must always use relative paths.
 2. Playlists must always be in the current directory.
 3. Directories fed to add must be relative to the current directory.
 4. Playlists will be normalized to 00_playlist.m3u unless
    --no-normalize is passed.
 5. For push, the destination can be either an absolute path or part
    of the full path of a mounted filesystem, in which case that will
    be used. For example, if a USB stick is mounted as /media/USB, and
    you specify USB/Music, then the playlists will be pushed to
    /media/USB/Music, and all files listed in those playlists will be
    pushed to the paths relative to /media/USB/Music.
^;

    # only allow one operation at a time
    foreach my $op ($push, $add, $new) {
        if ($op != 0) {
            ++$opcount;
        }
    }

    if ($opcount != 1) {
        print("One and only one operation must be specified.\n");
        $help = 1;
    }

    if ($help) {
        print($usage);
        $retVal = 0;
    }
    else {
        if ($push) {
            $retVal = sync($force, $verbose, $normalize);
        }
        elsif ($add) {
            $retVal = add(0, $verbose, $normalize, $extinf);
        }
        elsif ($new) {
            $retVal = add(1, $verbose, $normalize, $extinf);
        }
    }

    return $retVal;
}

&main();