#!/usr/bin/perl =head1 NAME MakeDVDArchives - A script to create DVD archives and the associated kover files =head1 SYNOPSIS MakeDVDArchives [ -bgcolor <hex color> ] [ -config < filename > ] [ -justburn ] [ -man ] [ -coverdir <directory> ] [ -h +elp ] [ -media <type> ] [ -outdir <directory> ] [ -outfile <filename> ] [ -srcdir <directory> ] [ -title <line 1> -title <line2> ] MakeDVDArchives -srcdir /music/dead/shn_1981_project \ -outfile 81.data -title 'Grateful Dead' \ -title '1981 Archive' =head1 OPTIONS =over =item B<-bgcolor> The hex color code you want the background of your covers to be. The default is #ffffff (white) =item B<-config> If you want to use a config file other than ~/.dvdarchiverc, you can provide the name here =item B<-coverdir> The directory to write the kover files out to. Defaults to ~/DVDCovers =item B<-help> A brief help message =item B<-justburn> Don't create any files, just burn the DVDs =item B<-man> Complete documentation =item B<-media> One of: 'dvd+r', 'dvd-r', 'dvd+r+dl', 'dvd-r+dl', depending on what sort of media you are burning to =item B<-outdir> Directory where you want the data about your DVDs written. Defaults to the current working directory =item B<-outfile> The name of the file to store the data to. Defaults to 'dvdarchive.data' =item B<-srcdir> The directory to archive. Defaults to the current working directory =item B<-title> This flag should be used if it is used at all. The two values are used to define both the kover filenames, as well as the actual titles printed on the kovers. For example, the default is the equivalent of: -title DVD -title Archive This would result in filenames like: DVD_Archive_DVD_1_and_2.kover And the title of that cover would read: DVD Archive Disc 1 & 2 =back =head1 DESCRIPTION B<MakeDVDArchives> will read the contents of a large directory, and divide it up into appropriate sized chunks for assorted sizes of DVD media. It will then: 1. Create a datafile describing what is on each DVD 2. Divide the DVDs into sets of two, for storage in dual jewel case +s 3. Create XML files for each set, for use with the program 'kover' for printing the covers for each set. The default covers are only the back insert, including spine text, so no insert for the front is printed. 4. Burn the DVDs, prompting you to insert blanks as appropriate The configuration can be controlled either via the command line, or th +e ~/.dvdarchiverc file. This is a completely linux-centric program. It uses growisofs to writ +e the DVDs, and the files for the covers it creates are for printing via the 'kover' program, part of the KDE suite. =head1 DEPENDENCIES This script requires the following modules which may not be installed in your perl installation: - Config::Std - IO::Handle - IO::Prompt - Object::InsideOut - Params::Validate - Pod::Usage - Switch - XML::Simple =head1 CONFIGURATION FILE A lot of the configuration options have to do with controlling the output to the covers for Kover to print. I don't know much about that....I've written out files that work, but some of the config options are a mystery to me. Hopefully everything works fine without this configuration file even existing. But you can cut & paste the following into ~/.dvdarchiverc [Program Defaults] coverdir = /home/stampes/personalDocuments/DVDCovers #mediatype = dvd+r outputdir = /home/stampes/personalDocuments/ArchiveData #outputfile = dvdarchive.data #sourcedir = '.' #title = DVD #title = Archive [Kover Content] color = #000000 font = Monospace fontsettings = Monospace,9,-1,5,50,0,0,0,0,0 italic = 0 size = 9 weight = 50 [Kover General] bgcolor = #ffffff [Kover Inlet] font = Helvetica fontsettings = helvetica,10,-1,5,50,0,0,0,0,0 italic = 0 size = 10 spinetext = 0 weight = 75 [Kover Title] color = #000000 display = 0 font = DejaVu Serif fontsettings = DejaVu Serif,20,-1,5,75,0,0,0,0,0 italic = 0 size = 20 weight = 75 [Burn] command = /usr/bin/growisofs flags = -dvd-compat -speed=16 -R -J -pad -Z device = /dev/hdi flagsuffix = -graft-points =cut MAIN: { #+----------------------------------------------------------------- # Load programming pragmas to keep us honest #+----------------------------------------------------------------- use strict; use warnings; #+----------------------------------------------------------------- # Define constants #+----------------------------------------------------------------- use constant { #+------------------------------------------------------------- # Defaults for various default values #+------------------------------------------------------------- DEFAULT_CONFIG => "$ENV{HOME}/.dvdarchiverc", DEFAULT_COVER_DIR => "$ENV{HOME}/DVDCovers", DEFAULT_MEDIA_TYPE => 'dvd+r', DEFAULT_OUTPUT_FILE => 'dvdarchive.data', DEFAULT_OUTPUT_DIR => '.', DEFAULT_SRC_DIR => '.', DEFAULT_TITLE => [ 'DVD', 'Archive' ], #+------------------------------------------------------------- # Constants for media data. For each type of data define a # command line string to describe if, and the size of it. If # new sizes/names of media are introduced, the switch statement # which determines capacity based on media type will need an # addition as well. #+------------------------------------------------------------- DVD_PLUS_R => 'dvd+r', DVD_MINUS_R => 'dvd-r', DVD_PLUS_R_DL => 'dvd+r+dl', DVD_MINUS_R_DL => 'dvd-r+dl', DVD_PLUS_R_SIZE => 4700372992, DVD_PLUS_R_DL_SIZE => 8543692390, # I don't use these so I didn't bother looking it up DVD_MINUS_R_SIZE => 0, DVD_MINUS_R_DL_SIZE => 0, }; #+----------------------------------------------------------------- # Load needed Modules #+----------------------------------------------------------------- use Config::Std; use File::Basename; use Getopt::Long; use IO::Handle; use IO::Prompt; use Pod::Usage; use Switch 'Perl6'; #+----------------------------------------------------------------- # For an application such as this, prefer autoflushed buffers #+----------------------------------------------------------------- *STDOUT->autoflush(); *STDERR->autoflush(); #+----------------------------------------------------------------- # Non-Command line globals #+----------------------------------------------------------------- my $capacity; my %argv; #+----------------------------------------------------------------- # Command line globals #+----------------------------------------------------------------- my $bgcolor; my $configFile = DEFAULT_CONFIG; my $coverDir; my $debug = 0; my $justburn; my $man; my $mediaType; my $help; my $outputDir; my $outputFile; my $srcDir; my @title; #+----------------------------------------------------------------- # React if no command line options were provided #+----------------------------------------------------------------- pod2usage("$0: No files given.") if (@ARGV == 0); #+----------------------------------------------------------------- # @ARGV gets munged by Getopt::Long, and we want to be able to look # later to see what options we got on the command line, so build a # hash for lookup #+----------------------------------------------------------------- for ( @ARGV ) { if ( $_ =~ /^-/ ) { $argv{ $_ } = 1; } } #+----------------------------------------------------------------- # Parse the command line and print a usage message if needed #+----------------------------------------------------------------- GetOptions( 'bgcolor=s' => \$bgcolor, 'config=s' => \$configFile, 'coverdir=s' => \$coverDir, 'debug' => \$debug, 'help' => \$help, 'justburn' => \$justburn, 'man' => \$man, 'media=s' => \$mediaType, 'outdir=s' => \$outputDir, 'outfile=s' => \$outputFile, 'srcdir=s' => \$srcDir, 'title=s@' => \@title, ) or pod2usage( { -message => 'Invalid command line argument.' } ) +; if ( $help ) { pod2usage( -message => 'Printing Help Message.', -exitval => 1, ); } if ( $man ) { pod2usage( -message => 'Printing documentation.', -exitval => 1, -verbose => 2 ); } #+----------------------------------------------------------------- # Load the config file. Then try to resolve values. # The precedence is: # - Use the command line value if provided # - Otherwise the the config file value if provided # - Otherwise use the default value #+----------------------------------------------------------------- my $rh_config = LoadConfig( { configfile => $configFile } ); if ( not $argv{ -media } ) { if ( my $configType = $rh_config->{'Program Defaults'}->{ mediatype } ) { $mediaType = $configType; } else { $mediaType = DEFAULT_MEDIA_TYPE; } } if ( not $argv{ -coverdir } ) { if ( my $configCoverDir = $rh_config->{'Program Defaults'}->{ coverdir } ) { $coverDir = $configCoverDir; } else { $coverDir = DEFAULT_COVER_DIR; } } if ( not $argv{ -outdir } ) { if ( my $configSaveDir = $rh_config->{'Program Defaults'}->{ outputdir } ) { $outputDir = $configSaveDir; } else { $outputDir = DEFAULT_OUTPUT_DIR; } } if ( not $argv{ -outfile } ) { if ( my $configSaveFile = $rh_config->{'Program Defaults'}->{ outputfile } ) { $outputFile = $configSaveFile; } else { $outputFile = DEFAULT_OUTPUT_FILE; } } if ( not $argv{ -srcdir } ) { if (my $configSrcDir = $rh_config->{'Program Defaults'}->{ sourcedir }) { $srcDir = $configSrcDir; } else { $srcDir = DEFAULT_SRC_DIR; } } if ( not $argv{ -title } ) { if ( my $configTitle = $rh_config->{'Program Defaults'}->{ title } ) { @title = @{ $configTitle } } else { @title = @{ DEFAULT_TITLE() }; } } #+----------------------------------------------------------------- # If options impacting the kover data were given, simply modify the # existing config with the new data for later use #+----------------------------------------------------------------- if ( $bgcolor ) { $rh_config->{'Kover General'}->{ 'bgcolor' } = $bgcolor; } #+----------------------------------------------------------------- # Determine the media capacity for the media to be used #+----------------------------------------------------------------- given ( $mediaType ) { when ( DVD_PLUS_R ) { $capacity = DVD_PLUS_R_SIZE; } when ( DVD_MINUS_R ) { $capacity = DVD_MINUS_R_SIZE; } when ( DVD_PLUS_R_DL ) { $capacity = DVD_PLUS_R_DL_SIZE; } when ( DVD_MINUS_R_DL ) { $capacity = DVD_MINUS_R_DL_SIZE; } } #+----------------------------------------------------------------- # Print a message explaining to the user what is about to happen an +d # make sure that's OK with them #+----------------------------------------------------------------- my $printCapacity = sprintf '%2.2f', $capacity / 1024 / 1024 / 1024 +; my $saveAs = "$outputDir/$outputFile"; my $userMessage = <<" END_USER_MESSAGE"; | | Here's what is going to happen now: | Directory to archive = $srcDir | Media Type = $mediaType | Media Capacity = $printCapacity GB END_USER_MESSAGE unless ( $justburn ) { $userMessage .= <<" END_USER_MESSAGE"; | Save list of DVDs as = $saveAs | Write Cover data to = $coverDir | Title Data is = $title[0] | $title[1] | END_USER_MESSAGE } $userMessage =~ s{^.+?\|}{}sgmx; print $userMessage; my $prompt = "Continue? ( [Y]es/[N]o ): "; my $response = prompt( $prompt, '-require' => { "Invalid Selection.\n$prompt" => qr/^[yn]$/i }, '-one_char' ); print "\n"; if ( $response =~ /^[Nn]$/ ) { exit; } #+----------------------------------------------------------------- # Get the list of contents of the directory. This should be made # more platform-neutral, but I'm too lazy to look up the perl # replacement for this right now. Once the list of raw data is # aquired, create a set of objects representing the entries #+----------------------------------------------------------------- my @read = `du -sbL $srcDir/*/.`; my @directories = map { s{^(.+)/.+$}{$1} ; $_ } @read; my $ra_dvdEntries = CreateDVDEntries({ contents => \@directories }) +; #+----------------------------------------------------------------- # Divide up the data into appropriately sized chunks and create a # set of DVD objects representing those chunks #+----------------------------------------------------------------- my $ra_DVDs = CreateDVDs( { contents => $ra_dvdEntries, capacity => $capacity, title => \@title } ); unless ( $justburn ) { #+-------------------------------------------------------------- # TOFIX: This is a part that could be more generic. A 'Set' # in this context is defined as a set of two DVDs. That's # because I use dual cases and want to print appropriate covers # for them. A 'Set' should # become a more generic concept with + # the user defining the size of the set defined by the user #+-------------------------------------------------------------- my $ra_Sets = CreateSets( { dvds => $ra_DVDs } ); #+-------------------------------------------------------------- # Write the output file. This is currently a flat text file, # but I have hopes it will become a SQLite database or somesuch #+-------------------------------------------------------------- WriteData( { dvds => $ra_DVDs, output => $saveAs }); #+-------------------------------------------------------------- # Create the kovers for the KDE program 'Kover' to print #+-------------------------------------------------------------- CreateKovers( { sets => $ra_Sets, title => \@title, coverdir => $coverDir, config => $rh_config } ); } #+----------------------------------------------------------------- # Finally, burn all the DVDs #+----------------------------------------------------------------- BurnDVDs( { dvds => $ra_DVDs, config => $rh_config->{ Burn }, debug => $debug} ); } =head1 DEVELOPER DOCUMENTATION OF SUBROUTINES The following is the documentation for all subroutines in the script =cut #+-------------------------------------------------------------------- # This guarantees a different scope for the main code and the # subroutines, ensuring all variables are properly scoped #+-------------------------------------------------------------------- SUBS: { #+----------------------------------------------------------------- # Default command for burning the DVD #+----------------------------------------------------------------- use constant { DEFAULT_COMMAND => '/usr/bin/growisofs', DEFAULT_DEVICE => '/dev/dvd', DEFAULT_FLAGS => '-dvd-compat -speed=16 -R -J -pad -Z', DEFAULT_SUFFIX => '-graft-points', }; use strict; use warnings; use Params::Validate qw( :all ); #------------------------------------------------------------------- # Documentation for CreateDVDEntries() #------------------------------------------------------------------- =head1 B<CreateDVDEntries( )> =over =item I<Parameters> =over =item B<contents> An array that's the output from du -b =back =item I<Return values> =over =item B<array ref> a reference to an array of DVD::Entry objects =back =item I<Description> Takes an array ref containing the contents of the directory and the size of each item, and creates an array of DVD::Entry objects representing those contents =back =cut #------------------------------------------------------------------- # End of Documentation for CreateDVDEntries() #------------------------------------------------------------------- sub CreateDVDEntries { validate( @_, { contents => { optional => 0, type => ARRAYREF }, } ); my $rh_args = $_[0]; my $ra_data = $rh_args->{ contents }; my @dvdEntries; for my $entry ( @{ $ra_data } ) { chomp $entry; next unless ( $entry ); my ( $size, $source ) = split /\s+/, $entry; my $name = basename $source; if ( -l $source ) { my $realSource = (split ' -> ', `ls -l $source`)[1]; chomp $realSource; $source = $realSource; } push @dvdEntries, DVD::Entry->new( name => $name, size => $size, source => $source ); } return \@dvdEntries; } #------------------------------------------------------------------- # Documentation for CreateDVDs() #------------------------------------------------------------------- =head1 B<CreateDVDs( )> =over =item I<Parameters> =over =item B<contents> A ref to an array of DVD::Entry objects =item B<capacity> The size of the media being used, in bytes =item B<title> A ref to a 2-element array representing the title for the DVDs =back =item I<Return values> =over =item B<array ref> a reference to an array of DVD objects =back =item I<Description> Given a set of DVD::Entry objects and the known capacity of the media, creates a set of DVD objects representing what will be stored on each DVD and the title of it =back =cut #------------------------------------------------------------------- # End of Documentation for CreateDVDs() #------------------------------------------------------------------- sub CreateDVDs { validate( @_, { contents => { optional => 0, type => ARRAYREF, callbacks => { 'Contains DVD::Entry objects' => sub { for ( @{ $_[0] } ) { unless ( $_->isa('DVD::Entry') ) { return 0; } } return 1; }, } }, capacity => { optional => 0 }, title => { optional => 0, type => ARRAYREF }, } ); my $rh_args = $_[0]; my $ra_contents = $rh_args->{ contents }; my $capacity = $rh_args->{ capacity }; my $ra_TitleText = $rh_args->{ title }; my $ContentsMax = $#{ $ra_contents }; my @DVDs; my $id = 1; my $index = 0; my $currentDVD; my $track = 1; while ( $index <= $ContentsMax ) { my $dir = $ra_contents->[ $index ]; my $dirSize = $dir->GetSize(); my $dvdSize = $currentDVD ? $currentDVD->GetSize() : 0; if ( $dvdSize + $dirSize < $capacity ) { $dir->SetNumber( $track++ ); unless ( $currentDVD ) { my $currentTitle = join ' ', @{ $ra_TitleText }, "DVD #$id"; $currentDVD = DVD->new( id => $id++, title => $currentTitle ); } $currentDVD->AddContent( $dir ); $index++; next; } else { push @DVDs, $currentDVD; $currentDVD = undef; $track = 1; } } if ( $currentDVD ) { push @DVDs, $currentDVD; } return \@DVDs; } #------------------------------------------------------------------- # Documentation for CreateSets() #------------------------------------------------------------------- =head1 B<CreateSets( )> =over =item I<Parameters> =over =item B<dvds> A ref to an array of DVD objects =back =item I<Return values> =over =item B<array ref> a reference to an array of DVD::Set objects =back =item I<Description> Given a set of DVD objects, creates a set of DVD::Set objects represen +ting the two DVDs going into a set, for packaging in dual jewel cases =back =cut #------------------------------------------------------------------- # End of Documentation for CreateSets() #------------------------------------------------------------------- sub CreateSets { validate( @_, { dvds => { optional => 0, type => ARRAYREF, callbacks => { 'Contains DVD objects' => sub { for ( @{ $_[0] } ) { unless ( $_->isa( 'DVD' ) ) { return 0; } } return 1; }, } } } ); my $rh_args = $_[0]; my $ra_DVDs = $rh_args->{ dvds }; my @sets; my ( $start, $end ) = ( 0, 1 ); while ( $start <= $#{ $ra_DVDs } ) { my $dvd1 = $ra_DVDs->[ $start ]; my $dvd2 = $ra_DVDs->[ $end ] || undef; $start += 2; $end += 2; my $contents = $dvd2 ? [ $dvd1, $dvd2 ] : [ $dvd1 ]; my $set = DVD::Set->new( dvds => $contents ); push @sets, $set; if ( not $dvd2 ) { last; } } return \@sets; } #------------------------------------------------------------------- # Documentation for LoadConfig() #------------------------------------------------------------------- =head1 B<LoadConfig( )> =over =item I<Parameters> =over =item B<configfile> Absolute path of the config file to load =back =item I<Return values> =over =item B<hash ref> a reference to a hash representing the config =back =item I<Description> Load the config file =back =cut #------------------------------------------------------------------- # End of Documentation for LoadConfig() #------------------------------------------------------------------- sub LoadConfig { my ( $rh_args ) = ( @_ ); my $configFile = $rh_args->{ configfile }; my $error = 0; if ( not -e $configFile ) { warn "$configFile does not exist.\n"; $error = 1; } elsif ( not -r $configFile ) { warn "$configFile not readable.\n"; $error = 1; } my %config; eval { read_config $configFile => %config; }; if ( $@ ) { warn "Exception occured reading $configFile: $@\n"; $error = 1; } if ( $error ) { my $prompt = "Continue with default values? ( [Y]es/[N]o ): " +; my $response = prompt( $prompt, '-require' => { "Invalid Selection.\n$prompt" => qr/^[yn]$/i }, '-one_char' ); print "\n"; if ( $response =~ /^[Nn]$/ ) { exit; } %config = (); } return \%config; } #------------------------------------------------------------------- # Documentation for WriteData() #------------------------------------------------------------------- =head1 B<WriteData( )> =over =item I<Parameters> =over =item B<dvds> Reference to an array of DVD objects =item B<output> File to write the data to =back =item I<Description> Writes out a simple text file of what is on each DVD =back =cut #------------------------------------------------------------------- # End of Documentation for WriteData() #------------------------------------------------------------------- sub WriteData { validate( @_, { dvds => { optional => 0, type => ARRAYREF, callbacks => { 'Contains DVD objects' => sub { for ( @{ $_[0] } ) { unless ( $_->isa( 'DVD' ) ) { return 0; } } return 1; }, } }, output => { optional => 0 }, } ); my ( $rh_args ) = ( @_ ); my $ra_DVDs = $rh_args->{ dvds }; my $outfile = $rh_args->{ output }; open OUT, '>', $outfile or die $!; for my $dvd ( @{ $ra_DVDs } ) { my $size = $dvd->GetSize(); $size = $size / 1024 / 1024 / 1024; printf OUT "\nDVD ID: %2d\n", $dvd->GetID(); printf OUT "DVD Size: %4.2f GB\n", $size; print OUT "================\n"; for my $dir ( @{ $dvd->GetContents() } ) { my $dirSize = $dir->GetSize() / 1024 / 1024; my $sizeTemplate = '%4d'; my $unit = 'MB'; if ( $dirSize > 1024 ) { $dirSize = $dirSize / 1024; $unit = 'GB'; $sizeTemplate = '%2.2f'; } printf OUT "\t%2d. %-60s => $sizeTemplate %2s\n", $dir->GetNumber(), $dir->GetName(), $dirSize, $unit +; } } } #------------------------------------------------------------------- # Documentation for BurnDVDs() #------------------------------------------------------------------- =head1 B<BurnDVDs( )> =over =item I<Parameters> =over =item B<dvds> Reference to an array of DVD objects =item B<config> Reference to a hash representing the config =item B<debug> Optional flag to get some debug output =back =item I<Description> Using the commands in the config, burn the DVDs and prompt for user to insert blank media between them =back =cut #------------------------------------------------------------------- # End of Documentation for BurnDVDs() #------------------------------------------------------------------- sub BurnDVDs { validate( @_, { dvds => { optional => 0, type => ARRAYREF, callbacks => { 'Contains DVD objects' => sub { for ( @{ $_[0] } ) { unless ( $_->isa( 'DVD' ) ) { return 0; } } return 1; }, } }, config => { optional => 0 }, debug => { optional => 1 }, } ); my ( $rh_args ) = ( @_ ); my $ra_DVDs = $rh_args->{ dvds }; my $config = $rh_args->{ config }; my $debug = $rh_args->{ debug }; my $command = $config->{ command } || DEFAULT_COMMAND; my $dvdDevice = $config->{ device } || DEFAULT_DEVICE; my $flags = $config->{ flags } || DEFAULT_FLAGS; my $suffix = $config->{ flagsuffix } || DEFAULT_SUFFIX; for my $dvd ( @{ $ra_DVDs } ) { my $fullcommand = "$command $flags $dvdDevice $suffix "; my $title = $dvd->GetTitle(); my $id = $dvd->GetID(); for my $entry ( @{ $dvd->GetContents() } ) { my $name = $entry->GetName(); my $src = $entry->GetSource(); $fullcommand .= qq{"/$name=$src" }; } print "Ready to burn $title\n"; my $prompt = "Select one of the following: [s]kip, [b]urn, [q]uit: " +; my $response = prompt( $prompt, '-require' => { "Invalid Selection.\n$prompt" => qr/^[sbq]$/ }, '-one_char' ); print "\n"; if ( $response eq 'q' ) { exit; } if ( $response eq 's' ) { next; } prompt( "Insert blank DVD for $title and press <RETURN>: " ); print "Preparing to burn DVD...please wait...\n"; open BURN, "$fullcommand 2>&1 |" or die $!; while ( <BURN> ) { chomp; if ( $debug ) { print "$_\n"; } elsif ( /estimate finish/ ) { print; print "\cH" x length $_; next; } elsif ( /flushing cache/ ) { print "\nFlushing Cache and Closing DVD, please wait.." +; } elsif ( /^:.+(?:error|failed)/ ) { print "$_\n"; } } close BURN; sleep 2; print "\nCompleted Burning $title\n"; system "eject $dvdDevice"; } } #------------------------------------------------------------------- # Documentation for CreateKovers() #------------------------------------------------------------------- =head1 B<CreateKovers( )> =over =item I<Parameters> =over =item B<sets> Reference to an array of DVD::Set objects =item B<config> Reference to a hash representing the config =item B<coverdir> Where to write the Kover files =item B<title> Reference to a two element array representing the config =item B<debug> Optional flag to get some debug output =back =item I<Description> Using the commands in the config, burn the DVDs and prompt for user to insert blank media between them =back =cut #------------------------------------------------------------------- # End of Documentation for BurnDVDs() #------------------------------------------------------------------- sub CreateKovers { validate( @_, { sets => { optional => 0, type => ARRAYREF, callbacks => { 'Contains DVD::Set objects' => sub { for ( @{ $_[0] } ) { unless ( $_->isa( 'DVD::Set' ) ) { return 0; } } return 1; }, } }, coverdir => { optional => 0 }, title => { optional => 0, type => ARRAYREF }, config => { optional => 0, type => HASHREF }, } ); my ( $rh_args ) = ( @_ ); my $ra_Sets = $rh_args->{ sets }; my $ra_TitleText = $rh_args->{ title }; my $coverDirectory = $rh_args->{ coverdir }; my $rh_config = $rh_args->{ config }; my $generalSection = DVD::Kover::General->new( config => $rh_config->{ 'Kover General' } ); my $imgSection = DVD::Kover::Images->new( ); my $inlet = DVD::Kover::Inlet->new( config => $rh_config->{ 'Kover Inlet' } ); for my $set ( @{ $ra_Sets } ) { my @currentTitle = @{ $ra_TitleText }; my ( $dvd1,$dvd2 ) = @{ $set->GetDVDs() }; my $discs = "DVD ".$dvd1->GetID(); if ( $dvd2 ) { $discs .= ' & '.$dvd2->GetID(); } push @currentTitle, $discs; my $titleSection = DVD::Kover::Title->new( config => $rh_config->{ 'Kover Title' }, text => \@currentTitle ); my $file = join "_", @currentTitle; $file =~ s/[ ]/_/g; $file =~ s/[&]/and/; $file .= '.kover'; my $ra_Content = [ {}, {}, 'Disc '.$dvd1->GetID().':' ]; for my $dir ( @{ $dvd1->GetContents } ) { push @{ $ra_Content }, $dir->GetNumber().'. '. $dir->GetName(); } if ( $dvd2 ) { push @{ $ra_Content }, {}; push @{ $ra_Content }, 'Disc '.$dvd2->GetID().':'; for my $dir ( @{ $dvd2->GetContents } ) { push @{ $ra_Content }, $dir->GetNumber().'. '. $dir->GetName(); } } my $content = DVD::Kover::Content->new( text => $ra_Content, config => $rh_config->{'Kover Content'}); my $kover = DVD::Kover->new( title => $titleSection, config => $rh_config, content => $content, general => $generalSection, images => $imgSection, inlet => $inlet ); print "Creating $file\n"; open OUT, '>', "$coverDirectory/$file" or die $!; print OUT $kover->GetXML(); } } } =head1 DOCUMENTATION FOR CLASSES The following is the documentation for all classes defined for use in this script. All classes are designed using Object::InsideOut. In most cases, ther +e are no interesting methods on the classes, they are just data containers. + As such, I am documenting the contructors only, and in rare cases the oth +er more interesting methods. All attributes have accessors/mutators usin +g the following naming convention (see Object::InsideOut for details): constructor attribute | Accessor | Mutator =================================================== name | GetName() | SetName() =cut BEGIN { #------------------------------------------------------------------- # Documentation for DVD::Entry #------------------------------------------------------------------- =head1 B<DVD::Entry> =head2 B<new()> =over =item I<Parameters> =over =item B<number> The track number on the DVD =item B<name> The name of the entry =item B<size> The size of the entry =item B<source> The absolute path to the source =back =item I<Description> Contructs a DVD::Entry object representing one item (file or subdirectory) on the DVD =back =cut #------------------------------------------------------------------- # End of Documentation for DVD::Entry #------------------------------------------------------------------- package DVD::Entry; { use strict; use warnings; use Object::InsideOut; my @trackNumber :Field( Get => 'GetNumber', Set => 'SetNumber' ) +; my @name :Field( Get => 'GetName', Set => 'SetName' ); my @size :Field( Get => 'GetSize', Set => 'SetSize' ); my @srcPath :Field( Get => 'GetSource', Set => 'SetSource' ) +; my %initArgs :InitArgs = ( track => { Type => 'Numeric', Field => \@trackNumber }, name => { Field => \@name }, size => { Field => \@size }, source => { Field => \@srcPath } ); } #------------------------------------------------------------------- # Documentation for DVD #------------------------------------------------------------------- =head1 B<DVD> =head2 B<new()> =over =item I<Parameters> =over =item B<id> An ID number to identify this DVD =item B<contents> A reference to an array of DBD::Entry objects =item B<size> The size of the DVD Data =item B<title> A two element array reference to be used as the title =back =item I<Description> Contructs a DVD::Entry object representing one item (file or subdirectory) on the DVD =back =cut #------------------------------------------------------------------- # End of Documentation for DVD #------------------------------------------------------------------- package DVD; { use strict; use warnings; use Object::InsideOut; my @id :Field( Get => 'GetID', Set => 'SetID' ); my @contents :Field( Get => 'GetContents', Set => 'SetContents' +); my @size :Field( Get => 'GetSize', Set => 'SetSize' ); my @title :Field( Get => 'GetTitle', Set => 'SetTitle' ); my %initArgs :InitArgs = ( id => { Type => 'Numeric', Field => \@id }, contents => { Type => 'LIST', Field => \@contents, Default => [ ] }, size => { Type => 'Numeric', Field => \@size, Default => 0 }, title => { Field => \@title, }, ); sub AddContent { my ( $self, $content ) = @_; push @{ $self->GetContents }, $content; $self->SetSize( $self->GetSize() + $content->GetSize() ); } } package DVD::Set; { use strict; use warnings; use Object::InsideOut; my @dvds :Field( Get => 'GetDVDs', Set => 'SetDVDs' ); my @title :Field( Get => 'GetTitle', Set => 'SetTitle' ); my %initArgs :InitArgs = ( dvds => { Type => 'LIST', Field => \@dvds } ); sub AddDVD { my ( $self, $dvd ) = @_; push @{ $self->GetDVDs() }, $dvd; } } package DVD::Kover; { use strict; use warnings; use Object::InsideOut; use XML::Simple; my @content :Field( Get => 'GetContent', Set => 'SetContent' ); my @general :Field( Get => 'GetGeneral', Set => 'SetGeneral' ); my @images :Field( Get => 'GetImages', Set => 'SetImages' ); my @inlet :Field( Get => 'GetInlet', Set => 'SetInlet' ); my @name :Field( Get => 'GetName', Set => 'SetName' ); my @title :Field( Get => 'GetTitle', Set => 'SetTitle' ); my @version :Field( Get => 'GetVersion', Set => 'SetVersion' ); my %initArgs :InitArgs = ( content => { Field => \@content, Type => 'DVD::Kover::Content', }, general => { Field => \@general, Type => 'DVD::Kover::General', }, images => { Field => \@images, Type => 'DVD::Kover::Images', }, inlet => { Field => \@inlet, Type => 'DVD::Kover::Inlet', }, name => { Field => \@name, Default => 'kover', }, title => { Field => \@title, Type => 'DVD::Kover::Title', }, version => { Field => \@version, Default => '2.9.6' }, ); sub GetAll { my ( $self ) = @_; return { content => $self->GetContent()->GetAll(), general => $self->GetGeneral()->GetAll(), img => $self->GetImages()->GetAll(), inlet => $self->GetInlet()->GetAll(), name => $self->GetName(), title => $self->GetTitle()->GetAll(), version => $self->GetVersion() }; } sub GetXML { my ( $self ) = @_; return XMLout( $self->GetAll() ); } } package DVD::Kover::Content; { use constant { DEFAULT_COLOR => '#000000', DEFAULT_FONT => 'Monospace', DEFAULT_FONT_SETTINGS => 'Monospace,9,-1,5,50,0,0,0,0,0', DEFAULT_ITALIC => 0, DEFAULT_SIZE => 9, DEFAULT_WEIGHT => 50, }; use strict; use warnings; use Object::InsideOut; my @color :Field( Get => 'GetColor', Set => 'SetCo +lor' ); my @config :Field( Get => 'GetConfig', Set => 'SetCo +nfig' ); my @font :Field( Get => 'GetFont', Set => 'SetFo +nt' ); my @fontSettings :Field( Get => 'GetFontSettings', Set => 'SetFo +ntSettings' ); my @italic :Field( Get => 'GetItalic', Set => 'SetIt +alic' ); my @size :Field( Get => 'GetSize', Set => 'SetSi +ze' ); my @text :Field( Get => 'GetText', Set => 'SetTe +xt' ); my @weight :Field( Get => 'GetWeight', Set => 'SetWe +ight' ); my %initArgs :InitArgs = ( text => { Field => \@text, Default => [ ], Type => 'LIST', }, ); sub _Init :Init { my ( $self, $args ) = @_; my $config = $args->{ config }; $self->SetConfig( $config ); if ( my $color = $config->{ color } ) { $self->SetColor( $color ); } else { $self->SetColor( DEFAULT_COLOR ); } if ( my $font = $config->{ font} ) { $self->SetFont( $font ); } else { $self->SetFont( DEFAULT_FONT ); } if ( my $fontsettings = $config->{ fontsettings } ) { $self->SetFontSettings( $fontsettings ); } else { $self->SetFontSettings( DEFAULT_FONT_SETTINGS ); } if ( my $italic = $config->{ italic } ) { $self->SetItalic( $italic ); } else { $self->SetItalic( DEFAULT_ITALIC ); } if ( my $size = $config->{ size } ) { $self->SetSize( $size ); } else { $self->SetSize( DEFAULT_SIZE ); } if ( my $weight = $config->{ weight } ) { $self->SetWeight( $weight ); } else { $self->SetWeight( DEFAULT_WEIGHT ); } } sub GetAll { my ( $self ) = @_; return { color => $self->GetColor(), font => $self->GetFont(), font_settings => $self->GetFontSettings(), italic => $self->GetItalic(), size => $self->GetSize(), text => $self->GetText(), weight => $self->GetWeight() }; } } package DVD::Kover::General; { use strict; use warnings; use constant { DEFAULT_BG_COLOR => '#ffffff', DEFAULT_CDDB_ID => '', DEFAULT_NUMBER => 0, }; use Object::InsideOut; my @bgColor :Field( Get => 'GetBGColor', Set => 'SetBGColor' ); my @config :Field( Get => 'GetConfig', Set => 'SetConfig' ); my @CDDBid :Field( Get => 'GetCDDBid', Set => 'SetCDDBid' ); my @number :Field( Get => 'GetNumber', Set => 'SetNumber' ); sub _Init :Init { my ( $self, $args ) = @_; my $config = $args->{ config }; $self->SetConfig( $config ); if ( my $bgcolor = $config->{ bgcolor } ) { $self->SetBGColor( $bgcolor ); } else { $self->SetBGColor( DEFAULT_BG_COLOR ); } if ( my $cddbID = $config->{ cddb_id } ) { $self->SetCDDBid( $cddbID ); } else { $self->SetCDDBid( DEFAULT_CDDB_ID ); } if ( my $number = $config->{ number } ) { $self->SetNumber( $number ); } else { $self->SetNumber( DEFAULT_CDDB_ID ); } } sub GetAll { my ( $self ) = @_; return { bgcolor => $self->GetBGColor(), cddb_id => $self->GetCDDBid(), number => $self->GetNumber() }; } } package DVD::Kover::Images; { use strict; use warnings; use Object::InsideOut; my @images :Field( Get => 'GetImages', Set => 'SetImages' ); my %initArgs :InitArgs = ( img => { Field => \@images, Default => [ { mode => 0, src => '', target => 0 }, { mode => 0, src => '', target => 0 }, { mode => 0, src => '', target => 0 }, ], Type => 'LIST' } ); sub GetAll { my ( $self ) = @_; return $self->GetImages(); } } package DVD::Kover::Inlet; { use strict; use warnings; use constant { DEFAULT_FONT => 'Helvetica', DEFAULT_FONT_SETTINGS => 'helvetica,10,-1,5,50,0,0,0,0,0', DEFAULT_ITALIC => 0, DEFAULT_SIZE => 10, DEFAULT_SPINE_TEXT => 0, DEFAULT_WEIGHT => 75, }; use Object::InsideOut; my @config :Field( Get => 'GetConfig', Set => 'SetCon +fig' ); my @font :Field( Get => 'GetFont', Set => 'SetFon +t' ); my @fontSettings :Field( Get => 'GetFontSettings', Set => 'SetFo +ntSettings' ); my @italic :Field( Get => 'GetItalic', Set => 'SetIta +lic' ); my @size :Field( Get => 'GetSize', Set => 'SetSiz +e' ); my @spineText :Field( Get => 'GetSpineText', Set => 'SetSpi +neText' ); my @weight :Field( Get => 'GetWeight', Set => 'SetWei +ght' ); my %initArgs :InitArgs = ( spinetext => { Default => 0, Field => \@spineText, }, ); sub _Init :Init { my ( $self, $args ) = @_; my $config = $args->{ config }; $self->SetConfig( $config ); if ( my $font = $config->{ font} ) { $self->SetFont( $font ); } else { $self->SetFont( DEFAULT_FONT ); } if ( my $fontsettings = $config->{ fontsettings } ) { $self->SetFontSettings( $fontsettings ); } else { $self->SetFontSettings( DEFAULT_FONT_SETTINGS ); } if ( my $italic = $config->{ italic } ) { $self->SetItalic( $italic ); } else { $self->SetItalic( DEFAULT_ITALIC ); } if ( my $size = $config->{ size } ) { $self->SetSize( $size ); } else { $self->SetSize( DEFAULT_SIZE ); } if ( my $weight = $config->{ weight } ) { $self->SetWeight( $weight ); } else { $self->SetWeight( DEFAULT_WEIGHT ); } } sub GetAll { my ( $self ) = @_; return { font => $self->GetFont(), font_settings => $self->GetFontSettings(), italic => $self->GetItalic(), size => $self->GetSize(), spine_text => $self->GetSpineText(), weight => $self->GetWeight() }; } } package DVD::Kover::Title; { use strict; use warnings; use constant { DEFAULT_COLOR => '#000000', DEFAULT_DISPLAY => 0, DEFAULT_FONT => 'DejaVu Serif', DEFAULT_FONT_SETTINGS => 'DejaVu Serif,20,-1,5,75,0,0,0,0,0', DEFAULT_ITALIC => 0, DEFAULT_SIZE => 20, DEFAULT_WEIGHT => 75, }; use Object::InsideOut; my @color :Field( Get => 'GetColor', Set => 'SetCo +lor' ); my @config :Field( Get => 'GetConfig', Set => 'SetCo +nfig' ); my @display :Field( Get => 'GetDisplay', Set => 'SetDi +splay' ); my @font :Field( Get => 'GetFont', Set => 'SetFo +nt' ); my @fontSettings :Field( Get => 'GetFontSettings', Set => 'SetFo +ntSettings' ); my @italic :Field( Get => 'GetItalic', Set => 'SetIt +alic' ); my @size :Field( Get => 'GetSize', Set => 'SetSi +ze' ); my @text :Field( Get => 'GetText', Set => 'SetTe +xt' ); my @weight :Field( Get => 'GetWeight', Set => 'SetWe +ight' ); my %initArgs :InitArgs = ( text => { Default => [], Field => \@text, Type => 'LIST', }, ); sub _Init :Init { my ( $self, $args ) = @_; my $config = $args->{ config }; $self->SetConfig( $config ); if ( my $color = $config->{ color } ) { $self->SetColor( $color ); } else { $self->SetColor( DEFAULT_COLOR ); } if ( my $display = $config->{ display } ) { $self->SetDisplay( $display ); } else { $self->SetDisplay( DEFAULT_DISPLAY ); } if ( my $font = $config->{ font} ) { $self->SetFont( $font ); } else { $self->SetFont( DEFAULT_FONT ); } if ( my $fontsettings = $config->{ fontsettings } ) { $self->SetFontSettings( $fontsettings ); } else { $self->SetFontSettings( DEFAULT_FONT_SETTINGS ); } if ( my $italic = $config->{ italic } ) { $self->SetItalic( $italic ); } else { $self->SetItalic( DEFAULT_ITALIC ); } if ( my $size = $config->{ size } ) { $self->SetSize( $size ); } else { $self->SetSize( DEFAULT_SIZE ); } if ( my $weight = $config->{ weight } ) { $self->SetWeight( $weight ); } else { $self->SetWeight( DEFAULT_WEIGHT ); } } sub GetAll { my ( $self ) = @_; return { color => $self->GetColor(), display => $self->GetDisplay(), font => $self->GetFont(), font_settings => $self->GetFontSettings(), italic => $self->GetItalic(), size => $self->GetSize(), text => $self->GetText(), weight => $self->GetWeight() }; } } } __END__
In reply to MakeDVDArchive by HuckinFappy
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |