#!/usr/bin/perl -w
#Last Updated: 2004.09.17 (xris)

###############################################################################
#
#            burncd, a script for burning ISO CD's of mp3 files
#
#        This script also creates the necessary .nautilus-metafile files,
#        sets up "music" views and sets up any cover art as folder icons.
#
###############################################################################

#Autoflush buffers
    $|++;

# Constant
    my $max_cd_size = 900000000;

#Load in the commandline arguments
    use Getopt::Long;
    my %Args;
    GetOptions(\%Args, 'help',
                    # Device options
                       'speed=i',
                       'device=s',
                       'list-devices',
                    # Blank a rewritable disk?
                       'blank:s',
                    # Normal burning options
                       'overburn',
                    # Verify something that was already burned?
                       'verify-only',
                    );

# Default arguments
    $Args{speed}  ||= 1;
    $Args{device} ||= '/dev/cdrom';

# Load the libraries used for verification
    use utf8;
    use File::Find;
    use File::Compare;

# Turn off warnings or the cdrecord call may generate UTF-8 errors
    no warnings;

# Scan the SCSI bus for compatible drives
    my @cd_devices;
    my $count = 0;
    foreach my $device (split(/(?=\nHost)/, `cat /proc/scsi/scsi`)) {
        my ($host, $channel, $id, $lun, $vendor, $model, $type)
            = $device =~ /Host:\s*scsi(\d+)\b\s*Channel:\s*(\d+)\s*Id:\s*(\d+)\b\s*Lun:\s*(\d+)\b
                          .+?Vendor:\s*(.+?)\b\s*Model:\s*(.+?)\b\s*Rev:.+?Type:\s*(.+?)\s/sx;
    # Not a cd drive, skip it.
        next unless ($type && $type =~ /cd-?rom/i);
    # Get some info about this device
        my $dev_id = join(',', $host+0, $id+0, $lun+0);
        my $output = `cdrecord -dev=$dev_id -prcap 2>/dev/null`;
    # Is this a burner?  If not, skip the device
        my $is_cd_burner  = $output =~ /does\s+write\s+CD/i ? 1 : 0;
        my $is_dvd_burner = $output =~ /does\s+write\s+DVD/i ? 1 : 0;
        next unless ($is_cd_burner || $is_dvd_burner);
    # Determine maximum write speeds
        my $cd_speed  = 0;
        my $dvd_speed = 0;
        if ($output =~ /Maximum\s+write\s+speed\s+in\s+kB\/s:\s*(\d+)/i
                or $output =~ /Maximum\s+write\s+speed:\s+(\d+)\s+kB\/s/i) {
            my $speed = $1;
            $cd_speed  = int($speed / 176)  if ($is_cd_burner);
            $dvd_speed = int($speed / 1385) if ($is_dvd_burner);
        }
        else {
            die "Unrecognized drive -prcap response from cdrecord:\n\n$output\n\n";
        }
    # Get some info about the normal device file
        my $device = '/dev/scd'.$count++;
    #
    # Really need to find some way to see if there is media in the drive or not
    #
    # Add it to the list
        push @cd_devices, {
                           'id'         => $dev_id,
                           'vendor'     => $vendor,
                           'model'      => $model,
                           'device'     => $device,
                           'cd_burner'  => $is_cd_burner,
                           'cd_speed'   => $cd_speed,
                           'dvd_burner' => $is_dvd_burner,
                           'dvd_speed'  => $dvd_speed,
                           'symlinks'   => []
                          };
    }

# Load in the devices listed in /etc/fstab
    my %fstab_devices;
    open(DATA, '/etc/fstab') or die "Can't read /etc/fstab:  $!\n\n";
    while (my $line = <DATA>) {
        my ($device, $mountpoint) = split(/\s+/, $line);
        if ($device =~ /^\/dev\//) {
            $fstab_devices{$device} = $mountpoint;
        }
    # Found a cd-like or dvd-like device?
        if ($device =~ /\/(?:cd|dvd)(?:writer|-?rom|rw)?$/i) {
        # Get some info about this device
            my $output = `cdrecord -dev=$device -prcap 2>/dev/null`;
        # Is this a burner?  If not, skip the device
            my $is_cd_burner  = $output =~ /does\s+write\s+CD/i  ? 1 : 0;
            my $is_dvd_burner = $output =~ /does\s+write\s+DVD/i ? 1 : 0;
            next unless ($is_cd_burner || $is_dvd_burner);
        # Pull out the vendor/model info
            my ($vendor) = $output =~ /^Vendor_info\s*:\s*'\s*(.+?)\s*'/m;
            my ($model) = $output =~ /^Identifikation\s*:\s*'\s*(.+?)\s*'/m;
        # Determine maximum write speeds
            my $cd_speed  = 0;
            my $dvd_speed = 0;
            if ($output =~ /Maximum\s+write\s+speed\s+in\s+kB\/s:\s*(\d+)/i
                    or $output =~ /Maximum\s+write\s+speed:\s+(\d+)\s+kB\/s/i) {
                my $speed = $1;
                $cd_speed  = int($speed / 176)  if ($is_cd_burner);
                $dvd_speed = int($speed / 1385) if ($is_dvd_burner);
            }
            else {
                die "Unrecognized drive -prcap response from cdrecord:\n\n$output\n\n";
            }
        #
        # Really need to find some way to see if there is media in the drive or not
        #
        # Add it to the list
            push @cd_devices, {
                               'id'         => $device,
                               'vendor'     => $vendor,
                               'model'      => $model,
                               'device'     => $device,
                               'cd_burner'  => $is_cd_burner,
                               'cd_speed'   => $cd_speed,
                               'dvd_burner' => $is_dvd_burner,
                               'dvd_speed'  => $dvd_speed,
                               'symlinks'   => []
                              };
        }
    }
    close DATA;
# Scan fstab and look for cd/dvd drives

# Turn warnings back on
    use warnings;

# No drives found?
    die "No SCSI CD or DVD burners found.\n\n" unless (@cd_devices > 0);

# Parse the found cd_devices and cd-like entries in /dev for matches.
    opendir(DIR, '/dev/') or die "Can't open directory /dev:  $!\n\n";
    foreach my $file (grep /^(cd-?[rw]|dvd)/i, readdir(DIR)) {
        substr($file, 0, 0) = '/dev/';
    # Make sure this device is listed in /etc/fstab
        #next unless ($fstab_devices{$file});
    # Check to see if $file is an alias to a known cd device
        if (-l $file) {
            my $link = readlink $file;
            foreach my $device (@cd_devices) {
                next unless ($link eq $device->{device});
                push @{$device->{symlinks}}, $file;
                last;
            }
        }
    # Not an alias?  Maybe it's a node that points to a known cd device
        elsif (0) {
        }
    }
    closedir(DIR);

# List devices?
    if ($Args{'list-devices'}) {
        print "\nDetected Burners:\n\n";
        foreach my $dev (@cd_devices) {
            print "    device:  $dev->{device}\n",
                  "    vendor:  $dev->{vendor}\n",
                  "     model:  $dev->{model}\n",
                  "   burn CD:  ", $dev->{cd_burner} ? 'Yes' : 'No',  "\n",
                  "  burn DVD:  ", $dev->{dvd_burner} ? 'Yes' : 'No', "\n",
                  "   symlink:  ", join(', ', @{$dev->{symlinks}}),
                  "\n\n";
        }
        exit;
    }

# Now we figure out which device we're supposed to be using
    my $cd_device = undef;
    foreach my $device (@cd_devices) {
    # First, we check the symlinks
        my $found = 0;
        foreach my $link (@{$device->{symlinks}}) {
            next unless ($link =~ /^$Args{device}$/);
            $found = 1;
            last;
        }
    # Not found, try matching one of the other strings
        if    ($device->{device} =~ /^$Args{device}$/) { $found = 1; }
        elsif ($device->{vendor} =~ /$Args{device}/i)  { $found = 1; }
        elsif ($device->{model}  =~ /$Args{device}/i)  { $found = 1; }
    # Found?
        next unless ($found);
        $cd_device = $device;
        last;
    }

# Unknown device?
    die "\nUnknown burner:  $Args{device}\n\n    Try:  burncd --list-devices\n\n" unless ($cd_device);

# Figure out the mount point
    $cd_device->{mount_device} = $cd_device->{device};
    $cd_device->{mountpoint}   = $fstab_devices{$cd_device->{device}};
    unless ($cd_device->{mountpoint}) {
        foreach my $link (@{$cd_device->{symlinks}}) {
            next unless ($fstab_devices{$link});
            $cd_device->{mount_device} = $link;
            $cd_device->{mountpoint}   = $fstab_devices{$cd_device->{mount_device}};
            last;
        }
    }

# Unknown mount point?
    die "\nCan't find mount point for $cd_device->{mount_device}; please check /etc/fstab\n\n" unless ($cd_device->{mountpoint});

# Blanking a disk?
    if (defined($Args{blank})) {
        $Args{blank} ||= 'fast';
        $Args{blank} =~ tr/A-Za-z0-9//cd;
        #$burn_program = $cd_device->{dvd_burner} ? 'dvdrecord' : 'cdrecord';
        $burn_program = 'cdrecord';
        exec "$burn_program -vv dev=$cd_device->{id} --blank=$Args{blank}";
        exit;    # not really necessary, but here in case something goes wrong with the exec
    }

# No arguments?
    if (!@ARGV) {
        die "Please specify a file/directory to burn.\n\n";
    }

# What are we trying to burn?  Is it a CD or a DVD?
    my $action;
    my $burn_program = 'cdrecord';
    my $burn_speed   = $cd_device->{cd_speed};
    my $the_file     = shift @ARGV;
        $the_file =~ s/\/*$//s;
    my $orig_file    = $the_file;

# In case we need one, create a volume name for this disk
    (my $ISOName = $the_file) =~ s/^.*?((?:[^\/]|(?<=\\)\/)+?)$/$1/s;
    $ISOName =~ tr/a-zA-Z0-9/_/sc;

# Too many arguments
    if (@ARGV) {
        die "Too many command line arguments.  Please specify only one file/directory to burn.\n\n";
    }
# Burning a bin/cue pair?
    if ($the_file =~ /^(.+?)\.(?:cue|bin)$/i) {
        my $cue = $1.'.cue';
    # Make sure the cue file exists
        die "Can't find $cue\n\n" unless (-e $cue);
    # Set the action, and save the filename
        $action = 'bincue';
        $the_file = $cue;
        $the_file =~ s/["\$]/\\"/sg;
    }
# Burning an iso image
    elsif ($the_file =~ /\.iso$/i) {
    # Get the size of this file, so we know if it'll fit on dvd or not
        my @stat = stat($the_file);
        my $size = $stat[7];
    # Estimating that this isn't going to fit on a single CD
        if ($size > $max_cd_size) {
            die "This file is too big to fit onto a CD.\nTry using a dvd burner.\n\n" unless ($cd_device->{dvd_burner});
            $burn_program = 'dvdrecord';
            $burn_speed   = $cd_device->{dvd_speed};
        }
    # Set the action and make the filename commandline safe
        $action = 'iso';
        $the_file =~ s/["\$]/\\"/sg;
    }
# Unrecognized file type
    elsif (!-d $the_file) {
        die "Unrecognized file type:  $the_file\n\n";
    }
# Burning files - this will take some more computing
    else {
    # Look at the files in this directory
        opendir(DIR, $the_file) or die "Can't open directory $the_file:  $!\n\n";
        my @files = sort grep(!/^\.\.?$/, readdir(DIR));
        closedir(DIR);
    # Empty directory?
        die "$the_file is an empty directory!\n\n" unless (@files);
    # Is this a directory of files intended for a dvd, but of the wrong format?
        my $found_dvd = 1;
        foreach my $file (@files) {
            if ($file !~ /\.(bup|ifo|vob)$/i) {
                $found_dvd = 0;
                last;
            }
        }
        die "You are attempting to burn a dvd, but failed to create the VIDEO_TS and AUDIO_TS directories.\n\n" if ($found_dvd);
    # Is this directory of dvd files?
        my $is_dvd = 0;
        foreach my $file (@files) {
            next unless ($file =~ /^video_ts$/i);
            $is_dvd = 1;
            last;
        }
        if ($is_dvd) {
                #@files == 2 && $files[0] =~ /^audio_ts$/i && $files[1] =~ /^video_ts$/i
                #|| @files == 1 && $files[0] =~ /^video_ts$/i) {
            die "You can't burn a dvd without a dvd burner.\n\n" unless ($cd_device->{dvd_burner});
            mkdir "$the_file/AUDIO_TS", 0755;
            $action = 'dvd';
            $burn_program = 'dvdrecord';
            $burn_speed   = $cd_device->{dvd_speed};
            $the_file =~ s/["\$]/\\"/sg;
        }
    # Or maybe a directory of music files
        elsif (scan_for_music(@files)) {
            $action = 'music';
            die "Audio CD burning is not yet supported.\n\n";
        }
    # Maybe it's just a bunch of files
        else {
        # Clean up the directory name so it's safe for command line use.
            $the_file =~ s/["\$]/\\"/sg;
        # Get the size of these files, so we know if it'll fit on dvd or not
            my $size = `du -sb "$the_file"`;
            $size =~ s/^(\d+)\b.*?$/$1/s;
        # Estimating that this isn't going to fit on a single CD
            if ($size > $max_cd_size) {
                die "This directory is too big to fit onto a CD.\nTry using a dvd burner.\n\n" unless ($cd_device->{dvd_burner});
                $burn_program = 'dvdrecord';
                $burn_speed   = $cd_device->{dvd_speed};
            }
        # Set the action
            $action = 'files';
        }
    }

# Set the global disk_verified var here
    my $disk_verified = 0;

# Only verifying?
    if ($Args{'verify-only'}) {
        print "Action:  verify $action\n";
        verify_disk();
        exit;
    }

# Report the action
    print "Action:  burn $action\n";

# Ask the user some questions about the burn...
    print "Detected drive speed:   ${burn_speed}x\n";

#Determine the max speed of the current disk
    $output = `$burn_program dev=$cd_device->{id} -atip 2>&1`;
    no warnings;
    if ($output =~ /speed\s+high:\s*(\d+)/i) {
        if ($burn_speed > $1) {
            $burn_speed = $1;
            print "Detected disk speed:   ${burn_speed}x\n";
        }
    }
    use warnings;

#Lastly, double check with the user about the disk speed
    my $answer;
    until ($answer and $answer > 0) {
        print "At what speed would you like to burn this disk [$burn_speed]?  ";
        $answer = <STDIN>;
        chomp $answer;
        $answer ||= $burn_speed;
        $answer =~ tr/0-9//cd;
    # Higher burn speed than detected?  Double check
        if ($answer > $burn_speed) {
            print "This is faster than the detected maximum, are you sure [N]?  ";
            my $answer2 = <STDIN>;
            chomp $answer2;
            $answer = 0 unless ($answer2 =~ /^\s*y(?:es)?/i);
        }
    }
    $burn_speed = $answer;

    print "Setting write speed:   ${burn_speed}x\n";

# Burn the disk
    if ($action eq 'bincue') {
        $overburn = $Args{overburn} ? ' --overburn' : '';
        print "\ncdrdao write$overburn --device $cd_device->{id} --driver generic-mmc -n --eject --speed $burn_speed \"$the_file\"\n\n";
        system("cdrdao write$overburn --device $cd_device->{id} --driver generic-mmc -n --eject --speed $burn_speed \"$the_file\"");
    }
    elsif ($action eq 'iso') {
        $overburn = $Args{overburn} ? ' -overburn' : '';
        system("$burn_program$overburn -vv dev=$cd_device->{id} speed=$burn_speed driveropts=burnfree -dao -eject \"$the_file\"");
    # Make sure the cd tray is closed
        system("eject -t $cd_device->{mount_device}");
    # Verify the disk
        verify_disk();
    }
    elsif ($action eq 'audio') {
        die "audio cd burning is disabled\n\n";
    }
    elsif ($action eq 'dvd') {
    # Make sure all of the files are uppercase
        opendir(DIR, $the_file) or die "Couldn't open directory $the_file\n\n";
        foreach my $file (grep(/^(audio|video)_ts$/i, readdir(DIR))) {
            finddepth({ wanted => \&uppercase, no_chdir => 1 }, "$orig_file/$file");
        }
        closedir(DIR);
    # Create a disk image
        system("nice -n 19 mkisofs -dvd-video -V \"$ISOName\" -o \"/tmp/$ISOName.iso\" \"$the_file\"");
    # Burn the disk
        system("$burn_program -vv dev=$cd_device->{id} speed=$burn_speed driveropts=burnfree -dao -eject \"/tmp/$ISOName.iso\"");
    #Make sure the cd tray is closed
        system("eject -t $cd_device->{mount_device}");
    #Verify the disk
        verify_disk();
    #Eject the cd
        system("eject $cd_device->{mount_device}");
    #Delete the .iso?
        $answer = '';
        while (!$answer) {
            print "Delete /tmp/$ISOName.iso ? [Y/n] ";
            $answer = <STDIN>;
            chomp $answer;
            $answer = '' if ($answer =~ /^[^yn]/i);
        }
        if ($answer =~ /^y/i) {
            unlink("/tmp/$ISOName.iso");
        }
    }
    elsif ($action eq 'files') {
    #Create a disk image
        system("nice -n 19 mkisofs -r -J -allow-leading-dots -allow-lowercase -allow-multidot -V \"$ISOName\" -o \"/tmp/$ISOName.iso\" \"$the_file\"");
    #Burn the directory to disk
        $overburn = $Args{overburn} ? ' -overburn' : '';
        system("$burn_program$overburn -vv dev=$cd_device->{id} speed=$burn_speed driveropts=burnfree -dao -eject \"/tmp/$ISOName.iso\"");
    #Make sure the cd tray is closed
        system("eject -t $cd_device->{mount_device}");
    #Verify the disk
        verify_disk();
    #Eject the cd
        system("eject $cd_device->{mount_device}");
    #Delete the .iso?
        $answer = '';
        while (!$answer) {
            print "Delete /tmp/$ISOName.iso ? [Y/n] ";
            $answer = <STDIN>;
            chomp $answer;
            $answer = '' if ($answer =~ /^[^yn]/i);
        }
        if ($answer =~ /^y/i) {
            unlink("/tmp/$ISOName.iso");
        }
    }

# Exit gracefully
    exit;

# Scans a list of files and returns true if they're all music files
    sub scan_for_music {
        foreach my $file (@_) {
            return 0 unless ($file =~ /\.(?:wav|mp[23]|ogg)$/i);
        }
        return 1;
    }

####
#
#    Verifies the burned disk against the original.
#
####
    sub verify_disk {
    # Can't verify bin/cue images
        if ($action eq 'bincue') {
            print "burncd cannot verify bin/cue images - if you know how, please let me know\n";
            return
        }
    # Can't verify audio disks
        elsif ($action eq 'audio') {
            print "Audio cd burning is disabled\n";
            return;
        }

    # Initialize the disk_verified variable
        $disk_verified = 1;
    # Mount the burnt disk
        system("mount $cd_device->{mountpoint}");

    # ISO images need to be mounted to a loopback device in order to be verified
        if ($action eq 'iso') {
        # Create a temporary directory for mounting the iso
            $tmp_dir = "/tmp/burncd.$$";
            mkdir $tmp_dir, 0755;
        # Mount the iso
            print "Mounting $the_file to $tmp_dir\n";
            system("mount \"$the_file\" $tmp_dir -o loop");
        # Verify the disk
            find({ wanted => \&verify_file, no_chdir => 1 }, $tmp_dir);
        # Unmount the iso and remove the temp directory
            system("umount $tmp_dir");
            rmdir $tmp_dir or print "Couldn't remove $tmp_dir:  $!\n";
        }
    # DVD or Files disks don't require anything special, just verify the tree
        elsif ($action eq 'dvd' || $action eq 'files') {
            find({ wanted => \&verify_file, no_chdir => 1 }, $the_file);
        }

    # Unmount the burnt disk
        system("umount $cd_device->{mountpoint}");
    # Let the user know how the verification went
        print $disk_verified
                ? "Disk verification completed successfully.\n"
                : "Disk verification FAILED.  I suggest that you reburn.\n";
    }

####
#
#    Verifies the burned disk's against the original - called via File::Find
#
####
    sub verify_file {
        my $copy = my $orig = $File::Find::name;
        my $safe = quotemeta $the_file;
        $copy =~ s/^$safe\/?/$cd_device->{mountpoint}\//s;
    # Perform the quick check for existence
        unless (-e $copy) {
            print "ERROR - $copy does not exist!\n";
            $disk_verified = 0;
            return;
        }
    # Not much to do for directories, but give the user some info about what's being checked
        if (-d $orig) {
            $copy = $orig;
            $copy =~ s/^$safe\/?//s;
            print "Verifying:  $copy\n";
            return;
        }
    # Print info out for every file on a dvd
        elsif ($burn_program eq 'dvdrecord') {
            print "Verifying:  $orig\n";
        }
    # Compare the files
        my $equality = compare($orig, $copy);
        return if ($equality == 0);
    # Try again, just in case
        print "Error comparing $copy (trying again)\n";
        $equality = compare($orig, $copy);
        return if ($equality == 0);
    # Nope, it really failed
        if ($equality == -1) {
            die "ERROR - error comparing:\n\t$orig\n\t$copy\n\n";
        }
        else {
            print "ERROR - $copy does not match the original!\n";
            $disk_verified = 0;
        }
    }

####
#
#    Makes all files and folders uppercase
#
####
    sub uppercase {
        my $new = $File::Find::name;
        $new =~ s/^(.*?)((?:[^\/]|(?<=\\)\/)+?)\/*$/$1\U$2/s;
        rename $File::Find::name, $new or die "Couldn't rename $File::Find::name to $new:  $!\n\n";
    }