The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package OTRS::OPM::Maker::Command::index;

use strict;
use warnings;

# ABSTRACT: Build index for an OPM repository

use File::Basename;
use File::Find::Rule;
use MIME::Base64 ();
use Sys::Hostname;
use Path::Class ();
use XML::LibXML;
use XML::LibXML::PrettyPrint;

use OTRS::OPM::Maker -command;

sub abstract {
    return "build index for an OPM repository";
}

sub usage_desc {
    return "opmbuild index <path_to_directory>";
}

sub validate_args {
    my ($self, $opt, $args) = @_;
    
    $self->usage_error( 'need path to directory that contains opm files' ) if
        !$args ||
        !$args->[0] ||
        !-d $args->[0];
}

sub execute {
    my ($self, $opt, $args) = @_;
    
    my $dir = $args->[0];
    
    my @opm_files = File::Find::Rule->file->name( '*.opm' )->in( $dir );
    
    my @packages;
    my $pp = XML::LibXML::PrettyPrint->new( 
        indent_string => '  ',
        element       => {
            compact => [qw(
                Vendor Name Description Version Framework 
                ModuleRequired PackageRequired URL License
                File
            )],
        },
    );
    
    for my $file ( @opm_files ) {
        my $parser = XML::LibXML->new;
        my $tree   = $parser->parse_file( $file );
        
        $tree->setStandalone( 0 );
        
        my $root_elem = $tree->getDocumentElement;
        $root_elem->setNodeName( 'Package' );
        $root_elem->removeAttribute( 'version' );
        
        # retrieve file information
        my @files = $root_elem->findnodes( 'Filelist/File' );
        
        FILE:
        for my $file ( @files ) {
            my $location = $file->findvalue( '@Location' );
            
            # keep only documentation in file list
            if ( $location !~ m{\A doc/}x ) {
                $file->parentNode->removeChild( $file );
            }
            else {
                my @child_nodes = $file->childNodes;
                
                # clean nodes
                $file->removeChild( $_ ) for @child_nodes;
                $file->removeAttribute( 'Encode' );
                $file->setNodeName( 'FileDoc' );
            }
        }
        
        # remove unnecessary nodes
        for my $node_name ( qw(Code Intro Database)) {
            for my $phase ( qw(Install Upgrade Reinstall Uninstall) ) {
                my @nodes = $root_elem->findnodes( $node_name . $phase );
                $_->parentNode->removeChild( $_ ) for @nodes;
            }
        }
        
        for my $node_name ( qw(BuildHost BuildDate)) {
            my @nodes = $root_elem->findnodes( $node_name );
            $_->parentNode->removeChild( $_ ) for @nodes;
        }
        
        my $file_node  = XML::LibXML::Element->new( 'File' );
        (my $file_path = $file) =~ s/\Q$dir//;
        $file_node->appendText( $file_path );
        $root_elem->addChild( $file_node );
        
        $pp->pretty_print( $tree );
        
        my $xml = $tree->toString;
        $xml =~ s{<\?xml .*? \?> \s+}{}x;
        
        push @packages, $xml;
    }
    
    print sprintf qq~<?xml version="1.0" encoding="utf-8" ?>
<otrs_package_list version="1.0">
%s
</otrs_package_list>
~, join "", @packages;
}

1;

__END__
=pod

=head1 NAME

OTRS::OPM::Maker::Command::index - Build index for an OPM repository

=head1 VERSION

version 0.05

=head1 AUTHOR

Renee Baecker <module@renee-baecker.de>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2012 by Renee Baecker.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)

=cut