The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- perl -*-
#
# Test::AutoBuild::Output::ISOBuilder by Daniel Berrange <dan@berrange.com>
#
# Copyright (C) 2004 Daniel Berrange <dan@berrange.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# 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.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# $Id: ISOBuilder.pm,v 1.1.2.1 2004/06/13 13:30:45 danpb Exp $

=pod

=head1 NAME

Test::AutoBuild::Output::ISOBuilder - Create CD ISO images

=head1 SYNOPSIS

  use Test::AutoBuild::Output::ISOBuilder


=head1 DESCRIPTION

This module creates CD ISO images containing packages for
a number of modules

=head1 METHODS

=over 4

=cut

package Test::AutoBuild::Output::ISOBuilder;

use Carp qw(confess);
use Test::AutoBuild::Output::TemplateGenerator;
use Test::AutoBuild::Lib;
use POSIX qw(strftime);
use Digest::MD5;

use strict;
use vars qw(@ISA);

@ISA = qw(Test::AutoBuild::Output::TemplateGenerator);


=pod

=item my $mod = Test::AutoBuild::Output::ISOBuilder->new(  );

=cut

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@_);

    bless $self, $class;

    return $self;
}


sub process {
    my $self = shift;
    my $modules = shift;
    my $groups = shift;
    my $repositories = shift;
    my $package_types = shift;
    
    my $destdir = $self->option("iso-dest-dir");
    if (! -e $destdir) {
        mkdir $destdir 
            or die "cannot create dir $destdir: $!";
    }
    
    my $scratchdir = $self->option("scratch-dir");
    $scratchdir = "/var/tmp" unless defined $scratchdir;
    
    my @isos;
    
    my %images = %{$self->option("images")};
    foreach my $key (sort keys %images) {
        my $image = $images{$key};
        my $name = $image->{name};
        
        my $vroot = "$scratchdir/$$-$name";
        mkdir $vroot 
            or die "cannot create virtual root directory $vroot: $!";
        
        my $cd_package_types = $image->{'package-types'};
        my $cd_modules = $image->{'modules'};
        
        $cd_package_types = keys %{$package_types}
        unless $cd_package_types;
        $cd_modules = [] unless $cd_modules;
        
        my %types;
        foreach my $type (@{$cd_package_types}) {
            mkdir "$vroot/$type"
                or die "cannot create dir $vroot/$type: $!";
            $types{$type} = 1;
        }
        
        
        foreach my $mod (@{$cd_modules}) {
            my $module = $modules->{$mod};
            warn "Process ISO $mod";
            die "cannot find module $mod" unless defined $module;
            
            my $packages = $module->packages;
            
            foreach my $filename (keys %{$packages}) {
                my $pkg = $packages->{$filename};
                
                if (exists $types{$pkg->type->name}) {
                    my $file = $filename;
                    $file =~ s,^.*/,,;
                    my $dst = $vroot . "/" . $pkg->type->name . "/" . $file;
                    
                    warn "Copy $filename -> $dst";
                    next if $file =~ /.md5$/;
                    
                    $self->_copy_file($filename, $dst);
                    $self->_create_file($pkg->md5sum, $dst . ".md5");
                } else {
                    warn "Skip $filename because " . $pkg->type->name . " is not wanted";
                }
            }
        }
        
        
        my $isofile = $destdir . "/" . $name;
        
        my $label = $image->{"label"} || "Untitled-Auto-Build-CD";
        
        system ("mkisofs -A '$label' -J --hide-joliet '*.md5' -r -o $isofile $vroot") == 0
            or die "cannot create iso $isofile: $?";	
        
        # cleanup
        foreach my $mod (@{$cd_modules}) {
            my $module = $modules->{$mod};
            my $packages = $module->packages;
            foreach my $filename (keys %{$packages}) {
                my $pkg = $packages->{$filename};
                $filename =~ s,^.*/,,;
                
                if (exists $types{$pkg->type->name}) {
                    my $file = $filename;
                    $file =~ s,^.*/,,;
                    my $dst = $vroot . "/" . $pkg->type->name . "/" . $file;
                    
                    next if $file =~ /.md5$/;
                    
                    unlink $dst
                        or die "cannot delete $dst: $!";
                    unlink "$dst.md5"
                        or die "cannot delete $dst.md5: $!";
                }
            }
        }
        foreach my $type (@{$cd_package_types}) {
            rmdir "$vroot/$type"
                or die "cannot delete dir $vroot/$type: $!";
        }
        rmdir $vroot
            or die "cannot delete $vroot: $!";
        
        
        my $md5 = Digest::MD5->new();
        open FILE, $isofile or die "cannot open $isofile: $!";
        $md5->addfile(\*FILE);
        
        my @stat = stat $isofile;
        
        push @isos, {
            label => $label,
            filename => $name,
            md5sum => $md5->hexdigest,
            size => Test::AutoBuild::Lib::pretty_size($stat[7])
            };
    }
    
    my %vars = (
		'isos', \@isos
                );
    $self->_generate_templates($modules, $groups, $repositories, $package_types, \%vars);
}

sub _copy_file {
    my $self = shift;
    my $src = shift;
    my $dst = shift;
    
    open SRC, "<$src"
	or die "cannot read $src: $!";
    open DST, ">$dst"
	or die "cannot create $dst: $!";
    
    # Memory is practically free!
    # ...but we should fix this to be efficient.
    local $/ = undef;
    print DST <SRC>;

    close SRC;
    close DST;
    
}

sub _create_file {
    my $self = shift;
    my $data = shift;
    my $dst = shift;
    
    open DST, ">$dst"
	or die "cannot create $dst: $!";
    
    print DST $data;
    
    close DST;
}

1 # So that the require or use succeeds.

__END__

=back 4

=head1 AUTHORS

Daniel Berrange <dan@berrange.com>

=head1 COPYRIGHT

Copyright (C) 2004 Daniel Berrange <dan@berrange.com>

=head1 SEE ALSO

L<perl(1)>

=cut