burn.pl

#!/usr/bin/perl
use warnings;
use strict;

burn.pl

burn.pl

OS X Perl script for burning image files to DVD

use File::Copy;

my $queue = "/Volumes/User/Users/me/Local/Scripts/Image/Burn Queue";
my $done  = "/Volumes/User/Users/me/Local/Scripts/Image/Burn Done";
my $path  = $done;
my $log   = "$path/log.txt";

sub dated_message {
    my ($msg) = @_;
    `echo >>"$log"`;
    `date '+%l:%M %p %Y-%m-%d' >>"$log"`;
    `echo "$msg" >> "$log"`;
}

sub short_message {
    my ($msg) = @_;
    `echo "$msg" >> "$log"`;
}

sub goodbye {
    my ($msg) = @_;
    dated_message "ERROR: $msg";
    exit -1;
}

sub shell_cmd {
    my ($do) = @_;
    my $result = `$do`;
    goodbye "$do" if $?;
    return $result;
}

Here is sample output from the drutil command:

% drutil list
   Vendor   Product           Rev   Bus       SupportLevel
1  MATSHITA DVD-R   UJ-845    D8PB  ATAPI     Apple Shipping
2  SONY     DVD RW DRU-810A   3.0b  FireWire  Vendor Supported

% drutil -devide 2 status
 Vendor   Product           Rev
 SONY     DVD RW DRU-810A   3.0b

           Type: DVD-R                Name: /dev/disk5
      Cur Write:    2x DVD          Sessions: 0
      Max Write:   16x DVD            Tracks: 0
   Overwritable:  510:46:46         blocks:  2298496 /   4.71GB /   4.38GiB
     Space Free:  510:46:46         blocks:  2298496 /   4.71GB /   4.38GiB
     Space Used:   00:00:00         blocks:        0 /   0.00MB /   0.00MiB
    Writability: appendable, blank, overwritable
       Media ID: SONY16D1

sub find_device {
    my ( $list, $status, $drive, $type, $ID, $speed, $capacity );

    $list = shell_cmd "drutil list";

    for my $device ( $list =~ /^(\d+)/mg ) {
        $status = shell_cmd("drutil -device $device status");

        if ( $status =~ /Type:\s+DVD/ and $status =~ /Writability:.*blank/ ) {

            # we should also compare capacity to needed capacity here
            ($drive) = $status =~ /^\s*Vendor\s+Product\s+Rev\s+(.*)\n/;
            $drive =~ s/\s+/ /g;
            ($type)     = $status =~ /^\s*Type:\s*(\S+)/m;
            ($ID)       = $status =~ /^\s*Media ID:\s*(\S+)/m;
            ($speed)    = $status =~ /^\s*Max Write:\s*(\S+)/m;
            ($capacity) = $status =~ /^\s*Space Free:.* (\S+iB)$/m;
            short_message "Drive: $drive";
            short_message "Media: $type $ID $speed, $capacity";
            return $device;
        }
    }
    goodbye "No media";
}

sub burn {
    my ($request,   $full_name, $name,     $ext,
        $burn_path, $burn_name, $full_md5, $burn_md5,
        $ok,        $device,    $script
    );

Get a burn request.

    chdir $queue
        or goodbye "Unable to find burn queue $queue";

    for my $file ( glob "*" ) {
        next if not -f $file;
        $request = $file;
        open my $FILE, '<', $request
            or goodbye "Unable to open $request";
        $full_name = <$FILE>;
        close $FILE;
        chomp $full_name;

        ( $path, $name, $ext ) = $full_name =~ m{^(.*)/([^/]+)\.([^.]+)$}
            or goodbye "Unable to parse $request : $full_name";
        $burn_path = "$path/$name";
        $burn_name = "$burn_path/$name.$ext";
        $full_md5  = "$path/md5.txt";
        $burn_md5  = "$burn_path/md5.txt";
        $log       = "$path/log.txt";

        if ( -f $full_name or -d $full_name or -f $burn_name ) {
            $ok = 1;
            last;
        }
    }
    goodbye "No valid burn requests" if not $ok;
    dated_message "Burning DVD: $name";

Check for media.

    $device = find_device;

Enclose in folder if bare file.

    if ( -d $full_name ) {
        $burn_path = $full_name;
    }
    elsif ( -f $full_name ) {
        if ( not -d $burn_path ) {
            mkdir $burn_path
                or goodbye "Unable to create $burn_path";
        }
        rename $full_name, $burn_name
            or goodbye "Unable to move $full_name to $burn_path";
        if ( -f $full_md5 ) {
            rename $full_md5, $burn_md5
                or goodbye "Unable to move $full_md5 to $burn_md5";
        }
    }
    elsif ( not -f $burn_name ) {
        goodbye "Can't find $full_name or $burn_name";
    }

Burn disc.

    `(time drutil -drive $device burn "$burn_path" 2>>"$log") 2>>"$log"`;

    goodbye "drutil burn error" if $?;

Remove from folder if was bare file.

    if ( $burn_path ne $full_name ) {
        rename $burn_name, $full_name,
            or goodbye "Unable to move $burn_name to $full_name";
        if ( -f $burn_md5 ) {
            rename $burn_md5, $full_md5
                or goodbye "Unable to move $burn_md5 to $full_md5";
        }
        rmdir $burn_path
            or goodbye "Unable to delete $burn_path";
    }

Move request from $queue to $done, with new creation date.

    copy( $request, "$done/$request" )
        or goodbye "Unable to copy $request to $done/$request";
    unlink $request
        or goodbye "Unable to delete $request";

    short_message "Done";
}

burn();