Subversion Repositories DevTools

########################################################################

# Copyright (c) VIX TECHNOLOGY (AUST) LTD

#

# Module name   : jats_gen_releasenote.pl

# Module type   : Makefile system

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : Generate the package Release Note

#                 Requires

#                   1) Release Note data generated by jats_get_releasenote_data.pl

#                   2) Target package in dpkg_archive

#                   3) One or more built.files.xxx.xml (optional, but desirable)

#

#                 Will:

#                   Merge built.files.xxx.xml files into the release note data

#                   Insert build meta data

#                   Save the Release Note MetaData within the package

#                   Generate the HTML release note - save within the package

#                   Insert Release_Contents into RM Database

#

# Usage:        See POD

#

#......................................................................#

require 5.008_002;

use strict;

use warnings;

use Pod::Usage;

use Getopt::Long;

use XML::Simple;

use File::Path;

use File::Copy;

use XML::Simple;

use Digest::MD5;

use File::Find;

use FindBin;                                # Determine the current directory

use Encode qw(decode encode);

use JatsError;

use JatsSystem;

use Getopt::Long;

use Pod::Usage;

use FileUtils;

use JatsEnv;

use JatsRmApi;

use DBI;

my $VERSION = "1.0.0";                                      # Update this. Inserted into meta data field

# User options

my $opt_verbose = 0;

my $opt_help = 0;

my $opt_archive;

my $archive_tag;

my $opt_pname;

my $opt_pversion;

my $opt_release_note;

my $opt_pvid;

my $opt_outname;

my $opt_outputXml;

my $opt_updateRmFiles;

my $opt_workingDir;

#   Global vars

our $GBE_HOSTNAME;

my $DPKG_ROOT;

my $DPKG_DOC;

my $JATS_RN;

my $OUT_ROOT;

#

#   Structure to translate -archive=xxx option to archive variable

#   These are the various dpkg_archives known to JATS

#

my %Archive2Var =( 'main'       =>  'GBE_DPKG',

                   'store'      =>  'GBE_DPKG_STORE',

                   'cache'      =>  'GBE_DPKG_CACHE',

                   'local'      =>  'GBE_DPKG_LOCAL',

                   'sandbox'    =>  'GBE_DPKG_SBOX',

                   'deploy'     =>  'GBE_DPLY',

                   );

#-------------------------------------------------------------------------------

# Function        : Main Entry

#

# Description     :

#

# Inputs          :

#

# Returns         :

#

{

    my $result = GetOptions (

                    "help+"         => \$opt_help,              # flag, multiple use allowed

                    "manual:3"      => \$opt_help,              # flag, set value

                    "verbose:+"     => \$opt_verbose,           # flag, increment

                    "archive=s"     => \$opt_archive,           # string

                    "releasenote=s" => \$opt_release_note,      # string

                    "UpdateRmFiles" => \$opt_updateRmFiles,     # flag

                    "WorkDir=s"     => \$opt_workingDir,        # String

                    );

    #

    #   Process help and manual options

    #

    pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);

    pod2usage(-verbose => 1)  if ($opt_help == 2 );

    pod2usage(-verbose => 2)  if ($opt_help > 2);

    ErrorConfig( 'name'    =>'GenRn', 'verbose' => $opt_verbose );

    InitFileUtils();

    #

    #   Needed EnvVars

    #

    EnvImport ('GBE_HOSTNAME');

    $JATS_RN = $FindBin::Bin;

    Error("Release Note tools not found", $JATS_RN)

        unless (-d $JATS_RN);

    #

    #   Sanity Check

    #

    Error("Release Note data not provided") unless $opt_release_note;

    Error("Release Note data not found") unless -f $opt_release_note;

    if (defined $opt_workingDir)

    {

        $opt_workingDir = FullPath($opt_workingDir);

        Error("Working directory is not a directory") unless -d $opt_workingDir;

        Error("Working directory is writable") unless -w $opt_workingDir;

    }

    #

    #   Determine the target archive

    #   The default archive is GBE_DPKG, but this may be changed

    #

    $opt_archive = 'main' unless ( $opt_archive );

    my $archive_tag = $Archive2Var{$opt_archive};

    Error("Unknown archive specified: $opt_archive")

        unless ( $archive_tag );

    $DPKG_ROOT = $ENV{$archive_tag} || '';

    Verbose ("Archive Variable: $archive_tag" );

    Verbose2 ("Archive Path: $DPKG_ROOT" );

    #

    #   Process the release note and extract essential information

    #

    processReleaseNote();

    #

    #   Locate the target package

    #

    $DPKG_ROOT = catdir($DPKG_ROOT, $opt_pname, $opt_pversion);

    Verbose ("Package Path: ", DisplayPath($DPKG_ROOT) );

    Error ("Package not found in archive", $DPKG_ROOT) unless -d $DPKG_ROOT;

    #   OUT_ROOT is really only used for testing

    #   Needs to mimic $DPKG_ROOT

    $OUT_ROOT = defined($opt_workingDir) ? $opt_workingDir : $DPKG_ROOT; 

    Verbose2 ("Output Path: $OUT_ROOT" );

    #

    #   Calculate output filenames

    #   Html Release Note:

    #       RELEASE_NOTES_PVID_PKGNAME_CLEANV.html

    #

    $DPKG_DOC = catdir($OUT_ROOT, 'doc');

    $opt_outputXml = catdir($DPKG_DOC, 'release_note.xml');

    my $cleanv = $opt_pversion;

    $cleanv =~ s~\.~_~g;

    $opt_outname = join('_',

                        'RELEASE_NOTES',

                        $opt_pvid,

                        $opt_pname,

                        $cleanv,    

                        ) . '.html';

    Verbose("Note Name: $opt_outname");

    #

    #   Locate the release note data file

    #   This was created as a prerequisite to the build

    #   Note: windows requires '/' in the file list

    #

    my @filesList;

    foreach my $item ( glob(catdir($DPKG_ROOT, 'built.files.*.xml'))) {

        $item =~ s~\\~/~g;

        push @filesList, $item;

    }

    unless (scalar @filesList > 0)

    {

        Warning("No file list found within the package: $opt_pname/$opt_pversion");

        #

        #   No filelist found in the package

        #   This may occur for packages that did not go though the build system

        #   Create a package-list

        #

        my $item = generateFileList();

        $item =~ s~\\~/~g;

        push @filesList, $item;

    }

    #

    #   Create output directory within the package

    #

    mkpath($DPKG_DOC, 0, 0775);

    #

    #   Merge the Release Note and the various file lists into a single

    #   XML file. Keep the file local

    #

    System('--NoShell', '--Exit', 'java', '-jar', 

           catdir($JATS_RN, 'saxon9he.jar'), 

           '-xsl:' . catdir($JATS_RN, 'merge.xslt'),

           "-s:$opt_release_note",

           'fileList=' . join(',', @filesList),

           '-o:' . 'built.files.releasenote.xml'

            );

    #

    #   Generate the HTML Release Note

    #   Output directly to the body of the package

    #

    System('--NoShell', '--Exit', 'java', '-jar', 

           catdir($JATS_RN, 'saxon9he.jar'), 

           '-xsl:' . catdir($JATS_RN, 'releaseNote2html.xslt'),

           '-s:' . 'built.files.releasenote.xml',

           "-o:" . catdir($DPKG_DOC, $opt_outname)

            );

    #

    #   Transfer the XML database directly into the package

    #

    unless( File::Copy::copy('built.files.releasenote.xml', $opt_outputXml) )

    {

        Error("Cannot transfer XML release note", $!, $opt_outputXml);

    }

    #

    #   Delete the built.files.xxx.xml that may be present in the root of the package

    #   These are no longer needed - they have been incorporated into the release_note.xml file

    #

    foreach my $item ( glob(catdir($DPKG_ROOT, 'built.files.*.xml'))) {

        unlink $item;

    }

    #

    #   Update the Release Manager entry - File Data

    #

    if ($opt_updateRmFiles)

    {

        updateRmFiles();

        updateRmNoteInfo();

    }

    #

    #   All done

    #

    Verbose ("Release Note:", DisplayPath(catdir($DPKG_DOC, $opt_outname)));

    exit 0;

}

#-------------------------------------------------------------------------------

# Function        : processReleaseNote 

#

# Description     : Extract essential information from the Release Note Data

#

# Inputs          : 

#

# Returns         : Populates global variables 

#

sub processReleaseNote

{

    my $xml = XMLin($opt_release_note);

    foreach my $item ( qw (name version pvid) ) {

        Error("Unexpected ReleaseNote format: package $item")

            unless (exists $xml->{package}{$item});

    }

    $opt_pname = $xml->{package}{name};

    $opt_pversion = $xml->{package}{version};

    $opt_pvid = $xml->{package}{pvid};

    Verbose("Package Name: $opt_pname") ;

    Verbose("Package Version: $opt_pversion") ;

    Verbose("Package Pvid: $opt_pvid") ;

}

#-------------------------------------------------------------------------------

# Function        : generateFileList

#                   generateFileListProc 

#

# Description     : A fileList has not been found in the target package

#                   Perhaps the package was not created by the build system

#                   

#                   Generate a fileList        

#

# Inputs          : None

#

# Returns         : Path to the generated file list

#

my @generateFileListData;

my $baseLength;

sub generateFileList

{

    my $outXmlFile;

    Verbose("Generate internal filelist - none found in package");

    #

    #   Scan the package and process each file

    #

    $baseLength = length($DPKG_ROOT);

    File::Find::find( \&generateFileListProc, $DPKG_ROOT );

    #

    #   Write out XML of the Generated file list

    #

    my $data;

    $data->{file} = \@generateFileListData;

    #

    #   Write out sections of XML

    #       Want control over the output order

    #       Use lots of attributes and only elements for arrays

    #       Save as one attribute per line - for readability

    #

    $outXmlFile = catdir($OUT_ROOT,"built.files.$GBE_HOSTNAME.xml");

    Verbose2('Meta File', $outXmlFile);

    my $xs = XML::Simple->new( NoAttr =>0, AttrIndent => 1 );

    open (my $XML, '>', $outXmlFile) || Error ("Cannot create output file: $outXmlFile", $!);

    $xs->XMLout($data, 

                'RootName' => 'files', 

                'XMLDecl'  => '<?xml version="1.0" encoding="UTF-8"?>',

                'OutputFile' => $XML);

    close $XML;

    return $outXmlFile;

}

sub generateFileListProc

{

    my %data;

    my $md5sum;

    my $source = $File::Find::name;

    my $type = 'dir';

    my $target = substr($source, $baseLength);

    $target =~ s~^/~~;

    $target =~ s~/$~~;

    Verbose2("GenFileList: $source, $target");

    return if (length ($target) == 0);

    if (-l $source)

    {

        $type = 'link';

    }

    elsif ( -f $source)

    {

        $type = 'file';

        Verbose2("Calculate MD5 Digest: $source");

        open(my $fh , $source) or Error ("Can't open '$source': $!");

        binmode $fh, ':crlf';

        $md5sum = Digest::MD5->new->addfile($fh)->hexdigest;

        close $fh;

    }

    #

    #   Convert from iso-8859-1 into utf-8

    #

    $target = decode( 'iso-8859-1', $target );

    $target = encode( 'utf-8', $target );

    if (-d $source)

    {

        $data{path} = $target;

    }

    else

    {

        $data{path} = StripFileExt($target);

        $data{name} = StripDir($target);

        if (defined $md5sum)

        {

            $data{size} = (stat($source))[7];

            $data{md5sum} = $md5sum;

        }

    }

    $data{fullname} = $target;

    $data{type} = $type;

    $data{machtype} = 'unknown';

    $data{host} = $GBE_HOSTNAME;

    # Put a nice '/' on the end of the patch elements

    $data{path} .= '/'

        if ( exists ($data{path}) && length($data{path}) > 0);

    push @generateFileListData, \%data;

}

#-------------------------------------------------------------------------------

# Function        : updateRmFiles 

#

# Description     : 

#

# Inputs          : 

#

# Returns         : 

#

my $RM_DB;

my  $updateRmFilesData;

sub updateRmFiles

{

    my $eCount = 0;

    #

    #   If in use the the autobuilder - which it should be, then

    #   modify the user name to access RM with a proxy user. This is the

    #   same method used in the 'buildtool'

    #

    if ($ENV{GBE_ABT} && $ENV{GBE_RM_USERNAME} && $ENV{GBE_RM_USERNAME} !~ m~]$~ )

    {

        Verbose("Access RM database as proxy user");

        $ENV{GBE_RM_USERNAME} = $ENV{GBE_RM_USERNAME} . '[release_manager]'; 

    }

    #

    #   Read in the release note data base

    #

    my $rnDataBase = catdir($DPKG_DOC, 'release_note.xml');

    if (! -f $rnDataBase )

    {

        Error("Release Note XML database not found: $!", $rnDataBase);

    }

    my $xml = XMLin($rnDataBase);

    #

    #   Sanity Test the data

    #

    Error("Sanity Check Failure. PVID") unless($opt_pvid eq $xml->{package}{pvid});

    Error("Sanity Check Failure. Name") unless($opt_pname eq $xml->{package}{name});

    Error("Sanity Check Failure. Version") unless($opt_pversion eq $xml->{package}{version});

    Error("Sanity Check Failure. File Section") unless(exists $xml->{files}{file});

    #DebugDumpData("XML DATA", \$xml);

    #

    #   Delete any existing entry(s)

    #

    updateRmFilesDelete();

    #

    #   Scan each entry and pump required data into the RM Database

    #   The {files}{file} may be either an array or a hash XMLin appears to

    #   make some decision as to which it will be, and I can't control it

    #

    #   If its a HASH, then it may be a HASH of HASH or a single entry

    #

    #   When it does happen the hash key is the 'name' element

    #

    if (ref($xml->{files}{file}) eq 'HASH')

    {

        Verbose("Convert file hash to an array");

        my @nowArray;

        foreach my $name ( keys %{$xml->{files}{file}})

        {

            my $entry = $xml->{files}{file}{$name};

            if (ref($entry) eq 'HASH')

            {

                $entry->{name} = $name;

                push @nowArray, $entry;

            }

            else

            {

                # Its a single entry, not a HASH of entries

                push @nowArray, $xml->{files}{file};

                last; 

            }

        }

        $xml->{files}{file} = \@nowArray

    }

    Error("Sanity Check Failure. File Section not an ARRAY") unless(ref($xml->{files}{file}) eq 'ARRAY');

    #

    #   Release Manager Database will barf if there are duplicate entries

    #   Maintain a hash of items processed, and only process each once

    #

    my %fullNameSeen;

    $updateRmFilesData = ""; 

    foreach my $entry (@{$xml->{files}{file}})

    {

        #

        #   Ignore 'merge' entries

        #

        next if ((exists $entry->{type}) && ($entry->{type} eq 'merge'));

        #

        #   Clean up the data

        #

        my $fname = $entry->{name} || '';

        my $fpath  = $entry->{path} || '';

        my $fsize  = $entry->{size} || 0;

        my $fmd5  = $entry->{md5sum} || '';

        $fpath =~ s~/$~~ unless $fname;

        unless( $fullNameSeen{$fpath}{$fname} )

        {

            $fullNameSeen{$fpath}{$fname} = 1;

            #

            #   Create SQL fragment for the insert

            #

            $eCount++;

            my $quoteFname = $fname;

            $quoteFname =~ s~'~''~g;

            my $entry = " INTO release_manager.release_components ( pv_id, file_name, file_path, byte_size, crc_cksum, crc_modcrc ) " .

                        " VALUES ( $opt_pvid, '$quoteFname', '$fpath',$fsize , '$fmd5', '')";

            $updateRmFilesData .= $entry;

            # The size of the aggregation is key to performance

            # Too big is as bad as too small

            if (length($updateRmFilesData) > 10000)

            {

                updateRmFilesInsert();

            }

        }

        else

        {

            Warning("Multiple file entries for: $fpath $fname");

        }

    }

    updateRmFilesInsert();

    Verbose ("Inserted $eCount entries into Release_Components");

}

#-------------------------------------------------------------------------------

# Function        : updateRmFilesInsert 

#

# Description     : Insert entries using the partial SQL statement 

#                   Must be called when the partial SQL buffer get large

#                   as well as at the end to fluch any outstanding inserts

#

# Inputs          : 

#

# Returns         : 

#

sub updateRmFilesInsert

{

    if (length($updateRmFilesData) > 0)

    {

        executeRmQuery(

            'updateRmFilesInsert',

            'INSERT ALL' . $updateRmFilesData . ' SELECT 1 FROM DUAL'

            );

        $updateRmFilesData = ""; 

    }

}

#-------------------------------------------------------------------------------

# Function        : updateRmFilesDelete 

#

# Description     : Delete ALL entires in the 'release_components' table associated

#                   with the current pvid

#                   

#                   Needs to be done before new entries are added.    

#

# Inputs          : 

#

# Returns         : 

#

sub updateRmFilesDelete

{

    executeRmQuery(

        'updateRmFilesDelete',

        'delete from release_manager.release_components where pv_id=' . $opt_pvid

        );

}

#-------------------------------------------------------------------------------

# Function        : updateRmNoteInfo 

#

# Description     : Insert Release Note Info into the Release Manager Database

#                   This has the side effect that RM will see the Release Note

#                   as being fully generated.

#

# Inputs          : 

#

# Returns         : 

#

sub updateRmNoteInfo

{

    #

    #   Determine the path to the Release Note in a form that is suitable for the Release Manager

    #   Database. This expects: /dpkg_archive/PkgName/PkgVer/doc/pkgFileName

    #

    my $rnPath = join('/', '', 'dpkg_archive', $opt_pname, $opt_pversion, 'doc', $opt_outname);

    Verbose("RN_INFO:", $rnPath);

    # Into the database

    executeRmQuery (

        'updateRmNoteInfo', 

        'update release_manager.package_versions set release_notes_info=\'' . $rnPath . '\' where pv_id=' . $opt_pvid

        );

}

#-------------------------------------------------------------------------------

# Function        : executeRmQuery 

#

# Description     : Execute a simple RM query. One that does not expect any return data

#

# Inputs          : $fname           - OprName, for error reporting

#                   $m_sqlstr        - SQL String

#

# Returns         : Will exit on error

#

sub executeRmQuery

{

    my ($fname, $m_sqlstr) = @_;

    #

    #   Connect to the Database - once

    #

    connectRM(\$RM_DB, 0) unless $RM_DB;

    Verbose2('ExecuteQuery:', $fname);

    #

    #   Create the full SQL statement

    #

    my $sth = $RM_DB->prepare($m_sqlstr);

    if ( defined($sth) )

    {

        if ( $sth->execute() )

        {

            $sth->finish();

        }

        else

        {

            Error("$fname: Execute failure: $m_sqlstr", $sth->errstr() );

        }

    }

    else

    {

        Error("$fname: Prepare failure");

    }

}

#-------------------------------------------------------------------------------

#   Documentation

#

=pod

=for htmltoc    SYSUTIL::

=head1 NAME

jats_gen_releasenote - Generate a Release Note

=head1 SYNOPSIS

 jats jats_gen_releasenote [options]

 Options:

    -help              - Brief help message

    -help -help        - Detailed help message

    -man               - Full documentation

    -verbose           - Display additional progress messages

    -outfile=name      - [Optional] Name of the output XML file

    -archive=name      - [Optional] Name package archive

    -releasenote=path  - Path to the Release Note Data

    -UpdateRmFiles     - Update the Files list in Release Manager

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>

Print a detailed help message with an explanation for each option.

=item B<-man>

Prints the manual page and exits.

=item B<-pvid=nn>

This option provides identifies the PackageVersion to be processed.

This option is mandatory.

=item B<-outfile=name>

This option specifies the output file name.

If not provided by the user the output filename will be created in the current directory

and it will be named after the package name and package version.

If the filename does not end in .xml, then .xml will be appended to the file name.

=item B<-UpdateRmFiles>

This option will case the utility to ppdate the Files list in Release Manager.

The existing file list will be replaced by the one within the package.

Note: Write Access to Release Manager is required.

=back

=head1 DESCRIPTION

This utility program is used to extract sufficient information from Release Manager and other

associated databases so that a Release Note can be created.

The extracted data is stored in an XML format. The intent is that XSLT will be used to create

an HTML based release note.

=head1 EXAMPLE

=head2 jats jats_gen_releasenote -releasenote=/tmp/myreleasenote.xml

This will process release note data in the specified XML file.

=cut