Subversion Repositories DevTools

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

# Copyright (c) VIX TECHNOLOGY (AUST) LTD

#

# Module name   : process_release_notes.pl

# Module type   : JATS Utility

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : Poll RM and generate Release Notes as required

#                 Must run on the same machine as the package archive

#                 It directly manipulates the target package

#                 Requires access to the machines sudo mechism

#

# Usage         : See POD at the end of this file

#

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

require 5.008_002;

use strict;

use warnings;

use JatsError;

use JatsSystem;

use Getopt::Long;

use Pod::Usage;                             # required for help support

use File::Temp qw/ tempfile tempdir /;

use LWP::UserAgent;

use HTTP::Request::Common 'POST';

use Fcntl ':flock';

use FindBin;                                # Determine the current directory

use JatsEnv;

use JatsRmApi;

use FileUtils;

use DBI;

my $VERSION = "1.0.0";                      # Update this

my $GBE_DPKG = $ENV{GBE_DPKG};              # Sanitised by Jats

my $RM_DB;

my $tempdir;

my $sudoUtilsDir = '/home/releasem/sbin';

my $lockFile = '/tmp/JATSRN_LOCK';

my $scriptDir = "$FindBin::Bin";

#

#   Options

#

my $opt_verbose = 0;

my $opt_help = 0;

my $opt_age = 2;

my $opt_keepTemp = 0;

my $opt_status = 0;

my $opt_pvid;

#

#   Package information

#

my @Packages;

my @packageItems = qw( PV_ID RTAG_ID NAME VERSION PKG_ID PROJ_ID RNINFO);

my %rmConfig;

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

# Function        : Main Entry

#

# Description     :

#

# Inputs          :

#

# Returns         :

#

my $result = GetOptions (

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

                'manual:3'      => \$opt_help,          # flag

                'verbose:+'     => \$opt_verbose,       # flag

                'age:i'         => \$opt_age,           # Number

                'keeptemp!'     => \$opt_keepTemp,      # flag

                'status+'       => \$opt_status,        # flag

                'pvid:i'        => \$opt_pvid,          # Number

                );

#

#   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'    =>'RelNotes', 

             'verbose' => $opt_verbose );

$opt_verbose-- if ($opt_verbose > 0);

#

#   Sanity Test

#

Error("Not running on a Unix System") unless ($ENV{GBE_UNIX});

Error("Sudo Utils not found: $sudoUtilsDir") unless ( -d $sudoUtilsDir);

Warning("Not running as a sutable user" ) unless ($ENV{USER} eq 'buildadm' || $ENV{USER} eq 'releasem');

EnvImport ('GBE_PERL');

#

#   Ensure only one instance is running

#   PerlMonks say to use $0 as the lock file, but that did not work.

#   Perhaps the file was open in an editor

#   Solution: Create my own file

#

open( FW, '>',$lockFile);

print FW '';

close FW;

open (my $self, '<', $lockFile) || Error("Couldn't open self: $!");

flock ($self, (LOCK_EX | LOCK_NB)) || Error("This script is already running");

#

#   Init parameters

#

$tempdir = tempdir('/tmp/JATSRN_XXXXXX',CLEANUP => !$opt_keepTemp);

Warning("Need to remove tempdir: " . DisplayPath($tempdir)) if $opt_keepTemp;

Verbose("Tempdir:" , DisplayPath($tempdir));

Verbose("scriptDir:" , DisplayPath($scriptDir));

#   Force GBE_ABT. Currently the Release Manager proxy password only works

#   When used in this mode

$ENV{GBE_ABT} = 1 unless defined $ENV{GBE_ABT};

#

#   User RW password, if provided

#

$ENV{GBE_RM_USERNAME} = $ENV{GBE_RM_USERNAME_RW} if (exists $ENV{GBE_RM_USERNAME_RW});

$ENV{GBE_RM_PASSWORD} = $ENV{GBE_RM_PASSWORD_RW} if (exists $ENV{GBE_RM_PASSWORD_RW});

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]'; 

}

#

#   Interogate the RM database and locate packages that need to be processed

#

$opt_pvid ? LocatePackagesByPvid() : LocatePackages();

Verbose("Package to process:" . scalar @Packages);

#DebugDumpData("Packages", \@Packages);

#

#   Process each found entry

#

foreach my $entry ( @Packages)

{

    GenerateReleaseNote( $entry);

}

unlink $lockFile;

exit 0;

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

# Function        : LocatePackages 

#

# Description     : Locate packages in need of Release Notes

#

# Inputs          : None

#

# Returns         : Nothing

#                   Populates the @Packages array

#

sub LocatePackages

{

    my $m_sqlstr =

            "SELECT * from

            (

                SELECT pv.pv_id, 

                       rc.rtag_id, 

                       pkg.pkg_name, 

                       pv.pkg_version, 

                       pv.pkg_id, 

                       rt.proj_id , 

                       pv.release_notes_info,

                       TRUNC(sysdate - pv.modified_stamp ) AS age , 

                       row_number() OVER (PARTITION BY pv.pv_id, pkg.pkg_name, pv.pkg_version ORDER BY rc.rtag_id) rn

                FROM release_manager.package_versions pv, 

                     release_manager.release_content rc, 

                     release_manager.packages pkg, 

                     release_manager.release_tags rt

                WHERE pv.pv_id = rc.pv_id

                AND pkg.pkg_id = pv.pkg_id

                AND rc.rtag_id = rt.rtag_id

                AND pv.pv_id IN (SELECT pv_id 

                                 FROM release_manager.package_versions 

                                 WHERE (release_notes_info IS null 

                                     OR release_notes_info like 'MSG:%' )

                                 AND pv.dlocked = 'Y'

                                 AND pv.modified_stamp > (sysdate - $opt_age)

                                 )

            )

            where rn = 1";

    populateArrayFromSql('LocatePackages', \@Packages, $m_sqlstr, \@packageItems);

#    DebugDumpData("Packages", \@Packages);

}

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

# Function        : LocatePackagesByPvid 

#

# Description     : Locate one package, as specified by its PVID

#                   This mode is only used in testing  

#

# Inputs          : Global: $opt_pvid 

#

# Returns         : Populate the @Packages array

#

sub LocatePackagesByPvid

{

    #   Extract: PV_ID RTAG_ID NAME VERSION PKG_ID PROJ_ID RNINFO AGE 

    my $m_sqlstr = "

                SELECT pv.pv_id, 

                       rc.rtag_id, 

                       pkg.pkg_name, 

                       pv.pkg_version, 

                       pv.pkg_id, 

                       rt.proj_id, 

                       pv.release_notes_info

                FROM release_manager.package_versions pv, 

                     release_manager.release_content rc, 

                     release_manager.packages pkg, 

                     release_manager.release_tags rt

                WHERE pv.pv_id = rc.pv_id

                AND pkg.pkg_id = pv.pkg_id

                AND rc.rtag_id = rt.rtag_id

                AND pv.pv_id = $opt_pvid

                ";

    populateArrayFromSql('LocatePackagesByPvid', \@Packages, $m_sqlstr, \@packageItems);

    #DebugDumpData("Packages", \@Packages);

}

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

# Function        : GenerateReleaseNote  

#

# Description     : Generate One Release Note

#                   Invoke several JATS utilities to do the hard work

#

# Inputs          : $entry          - Hash of useful infomation

#

# Returns         : Nothing

#                   Will exit on error

#

sub GenerateReleaseNote

{

    my ($entry) = @_;

    my $outfile;

    my $rv;

    my @args;

    #DebugDumpData("Entry", $entry);

    Message("-------------------- $entry->{NAME}, $entry->{VERSION}") if $opt_status || $opt_verbose;

    my $pkgBase = catdir($GBE_DPKG, $entry->{NAME}, $entry->{VERSION});

    Verbose("Processing: $pkgBase");

    unless (-d $pkgBase) {

        Warning("Package not in archive: $pkgBase");

        return;

    }

    #

    #   Make the target Package Version Writable and Ensure that the doc directory

    #   exists. This is done via a script that is invoked with SUDO, partially to

    #   interwork with the existing system  

    #

    runSudoCommand('make_writable', 'dpkg_archive', $entry->{NAME},$entry->{VERSION});

    runSudoCommand('make_docFolder', 'dpkg_archive', $entry->{NAME},$entry->{VERSION}, 'doc');

    #

    #   Get the basic data required for the Release Note

    #   jats jats_get_releasenote_data.pl -pvid=1002782

    #

    $outfile = catdir($tempdir, join('_',$entry->{NAME},$entry->{VERSION})) . '.xml';

    $rv = localTool('jats_get_releasenote_data', '-verbose', $opt_verbose, '-pvid', $entry->{PV_ID}, '-outfile', $outfile );

    #

    #   Generate the actual release note and update the Release Manager

    #   jats jats_gen_releasenote.pl -releasenote=mcrdemo_1.2.3157.cr.xml -UpdateRmFiles

    unless ($rv)

    {

        $rv = localTool('jats_gen_releasenote.pl', '-verbose', $opt_verbose, '-UpdateRmFiles', '-releasenote', $outfile);

    }

    #

    #   Release note complete - or failed

    #       Make the target PackageVersion ReadOnly

    #       Signal End of Package Processing - which will trigger blat

    #

    #   Do this even if we have a Release Note Failure

    #

    runSudoCommand('make_readonly', 'dpkg_archive', $entry->{NAME},$entry->{VERSION});

    #    make_release_changed 

    #       archive=archive-path 

    #       pkg_name=package-name 

    #       pkg_version=package-version 

    #       rtag_id=release-tag-id 

    #       pkg_id=package-id 

    #       pv_id=package-version-id 

    #       proj_id=project-id 

    #       mode_id=change-mode-id (1 pkg added, 2 pkg removed, 3 pkg released)

    #

    push @args, 'archive=dpkg_archive';

    push @args, 'mode_id=3';

    push @args, 'pkg_name='    . $entry->{NAME};

    push @args, 'pkg_version=' . $entry->{VERSION};

    push @args, 'rtag_id='     . $entry->{RTAG_ID};

    push @args, 'pkg_id='      . $entry->{PKG_ID};

    push @args, 'pv_id='       . $entry->{PV_ID};

    push @args, 'proj_id='     . $entry->{PROJ_ID};

    runSudoCommand('make_release_changed', @args);

    #

    #   Email interested users

    #

    notifyInterestedUsers($entry);

    Error ("Did not generate Release Note: $entry->{NAME}, $entry->{VERSION}") if ($rv);

}

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

# Function        : localTool 

#

# Description     : Run a jats tool from the same directory as this script 

#

# Inputs          : $name           - Name of the script

#                   ...             - Arguments for the command

#

# Returns         : 

#

sub localTool

{

    my $cmd = shift;

    $cmd .= '.pl' unless ( $cmd =~ m~\.pl$~i );

    $cmd = catdir($scriptDir, $cmd);

    Error ("Command not found: $cmd") unless -f $cmd;

    return System ( '--NoShell', $::GBE_PERL, $cmd, @_ );

}

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

# Function        : notifyInterestedUsers  

#

# Description     : A user can register interest in a package (name) being built in a 

#                   specific Project 

#                   Perhaps this should be done by the build tool, but at the moment 

#                   this release note generation process is really a part of the build

#

#                   NOTE: Similar code exists in the RM web server to handle manually

#                         released packages.

#                   

# Inputs          : $entry          - Hash of useful infomation

#

# Returns         : 

#

sub notifyInterestedUsers

{

    my ($entry) = @_;

    my @userList;

    #

    #   Determine interested users

    #

    my $m_sqlstr = "SELECT U.user_email, prj.proj_name, rt.rtag_name, pkg.pkg_name, pv.pkg_version ,pv.pv_id, rt.rtag_id

        FROM PACKAGE_INTEREST PI, 

             PACKAGES PKG, 

             PACKAGE_VERSIONS PV, 

             USERS U,

             RELEASE_TAGS RT, 

             PROJECTS PRJ 

        WHERE PKG.PKG_ID = PI.PKG_ID 

          AND RT.RTAG_ID = $entry->{RTAG_ID}

          AND PV.PV_ID = $entry->{PV_ID}

          AND PV.PKG_ID = PKG.PKG_ID 

          AND PRJ.PROJ_ID = RT.PROJ_ID 

          AND PRJ.PROJ_ID = PI.PROJ_ID 

          AND U.USER_ID = PI.USER_ID";

    my @items = qw( USER_EMAIL PROJ_NAME RTAG_NAME PKG_NAME PKG_VERSION PV_ID RTAG_ID );

    populateArrayFromSql('notifyInterestedUsers', \@userList, $m_sqlstr, \@items);

    #

    #   Do we have something to do

    #

    return unless (@userList);

    #DebugDumpData("userList", \@userList);

    #   Ensure we have basic emailing information

    #

    getRmConfig();

    #

    #   Send Email to all the required users

    #   Note: This emailer requires a sendmail utility

    #

    foreach my $entry ( @userList)

    {

        #$entry->{USER_EMAIL} = 'dpurdie@vixtechnology.com';

        #Debug0("Sending email to David Purdie indead of real user");

        my $subject = "Package Release Notification: $entry->{PKG_NAME} $entry->{PKG_VERSION}";

        my $content = "Version <a href='http://bms:8002/ManagerSuite/Release_Manager/fixed_issues.asp?pv_id=$entry->{PV_ID}&rtag_id=$entry->{RTAG_ID}'>$entry->{PKG_VERSION}</a> of Package $entry->{PKG_NAME} in Project $entry->{PROJ_NAME} on Release Branch $entry->{RTAG_NAME} has been released.";

           $content .= "<p>Package Link: http://bms:8002/ManagerSuite/Release_Manager/fixed_issues.asp?pv_id=$entry->{PV_ID}&rtag_id=$entry->{RTAG_ID}";

           $content .= "<p>You have received this email as a result of your interest in this package. If you do not wish to receive further emails then remove your package interest from the notifications area in Release Manager.";

        my $req = POST( 'mailto:' . $entry->{USER_EMAIL},

            From         => $rmConfig{'BUILD FAILURE MAIL SENDER'},

            CC           => 'buildadm@vixtechnology.com',

            Date         => scalar localtime,

            Subject      => $subject,

            Content_Type => qq(text/html),

            Content      => $content,

        );

        my $response = LWP::UserAgent->new->request($req);

        if ($response->code != 202)

        {

            Warning("Email Send Error: $response->code");

            #DebugDumpData("Response", \$response);

        }

    }

}

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

# Function        : getRmConfig 

#

# Description     : Get Basic config from Release Manager

#                   Only do it once

#

#                   Just need:

#                       'BUILD FAILURE MAIL SENDER'

#                       'MAIL SERVER'

#

# Inputs          : None

#

# Returns         : Populates a global hash

#

sub getRmConfig

{

    return if keys(%rmConfig) > 0;

    my $m_sqlstr = "SELECT * from BUILD_SERVICE_CONFIG";

    performSqlQueryCallback('getRmConfig', 

                            $m_sqlstr, 

                            sub { 

                                my ($pRow) = @_;

                                $rmConfig{ $pRow->[0] } = $pRow->[1];

                                }

                            );

#DebugDumpData("rmConfig", \%rmConfig);

}

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

# Function        : runSudoCommand 

#

# Description     : Run a Unix command as root via the sodo system

#                   Requires that target commands be available

#                   Requires sudo to be configured to allow this user to run them

#

# Notes           : The sudoers file on the archive server needs to be configured to allow:

#                       This user to run programs from /home/releasem/sbin without a password

#                       The users sudo credentials must not timeout (or be used)

#

# Inputs          : prog            - Command to run

#                   arguments       - Command arguments

#

# Returns         : Nothing 

#

sub runSudoCommand

{

    my ($prog, @arguments) = @_;

    my $cmd;

    my $rv;

    #

    #   Construct command

    #

    $cmd = catdir($sudoUtilsDir, $prog);

    $rv = System('--NoShell','sudo','-n', $cmd, @arguments);

    Warning("SudoCmd Result: $prog: $rv") if ($rv);

}

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

# Function        : performSqlQueryCallback 

#

# Description     : Perform a general Sql query and invoke a user function for

#                   each row of results

#

# Inputs          : $fname                  - Name of query for error reporting

#                   $m_sqlstr               - Query string

#                   $f_process              - Function called for each row in the result

#                                             Use closure to have callback modify other data

#

# Returns         : Number of rows found

#

sub performSqlQueryCallback

{

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

    my $found = 0;

    #

    #   Connect to the database - once

    #

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

    $m_sqlstr =~ s~\s+~ ~g;

    Verbose3("SQL:", $m_sqlstr);

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

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( my @row = $sth->fetchrow_array )

                {

                    $found++;

                    &$f_process(\@row);

                }

            }

            $sth->finish();

        }

        else

        {

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

        }

    }

    else

    {

        Error("$fname:Prepare failure" );

    }

    unless ( $found )

    {

        Verbose("$fname:No data found");

    }

    return $found;

}

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

# Function        : populateArrayFromSql 

#

# Description     : Issue an SQL query and push the results into an array of hashes

#                   where each row from the query is a hash and the entire result is an 

#                   array 

#

# Inputs          :     name                - For error reporting

#                       pArray              - Ref to the output array

#                       sql                 - Sql to process

#                       pItems              - Array of tems to extract

#                                             Must match the SQL SELECT arguments

#                                             Item names starting with '-' do not end up in the

#                                             generated XML

# Returns         : 

#

sub populateArrayFromSql

{

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

    performSqlQueryCallback($fname, 

                            $m_sqlstr, 

                            sub { 

                                my ($pRow) = @_;

                                my %entry;

                                push @{$pArray}, populateHash( \%entry, $pRow, $pItems);

                                }

                            );

#DebugDumpData("populateArrayFromSql", $pArray);

}

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

# Function        : populateHash 

#

# Description     : Put an array of data items into a hash

#

# Inputs          : pHash           - ref to output hash

#                   pRow            - Ref to the row data 

#                   pItems          - Ref to an hash array of entry names

#

# Returns         : pHash

#

sub populateHash

{

    my ($pHash, $pRow, $pItems) = @_;

    foreach my $item ( @{$pItems} ) {

        my $data = shift @{$pRow};

        if (defined $data)

        {

            $data =~ s~^\s+~~;

            $data =~ s~\s+$~~;

            #

            #   Store in hash

            #

            $pHash->{$item} = $data;

        }

    }

    return $pHash;

}

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

#   Documentation

#

=pod

=for htmltoc    SYSUTIL::

=head1 NAME

process_release_notes - Create Release Notes for newly created packages

=head1 SYNOPSIS

 jats process_release_notes [options]

 Options:

    -help              - Brief help message

    -help -help        - Detailed help message

    -man               - Full documentation

    -verbose           - Display additional progress messages

    -pvid=nn           - PVID of package to process(test mode)

    -age=nn            - Examine packages created in last n days

    -keeptemp          - Keep the temp workspace

    -status            - Display status

=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 bypasses the normal mechanism of determining packages to be processed and 

will process just the specified package. This is normally only used to test the operation 

of the subsystem.

=item B<-age=nn>

This option control the period of time period used in determing which packages to process. 

The number is in days. The default value is 2 days.

=item B<-keeptemp>

If this option is specified, then the temporary directory created in the processing will be 

retained. The user is responsible for deleting the directory.

This option is normally only used in testing.

=item B<-status>

When set, this option will cause the program to display the package name and version of each

package being processed.

=back

=head1 DESCRIPTION

This utility program is apart of the Package Release process. It is an interim solution.

The script is designed to be run as a cron jon on the dpkg_archive server.

It will scan the Release Manager database for packages that have been release, but do 

not yet have release notes. For each package it will then generate a Release Note by: 

=over 4

=item *

Invoke jats_get_releasenote_data to:

Extract relevent information from

=over 4

=item *

The Release Manager database

=item *

the ClearQuest database (now conatined within the Release Manager database)

=item *

the Jira Issue server 

=back

and create and XML file.

=item *

Invoke jats_gen_releasenote to:

=over 4

=item *

Process the the XML file created above, and package list info found within the new package. 

If no package informationis found then the utility will create a package list, but this is 

much slower than having it created by the package builder.

=item *

Create an XML file containing all the package information

=item *

Create an HTML based Release Note, from the XML file. This file could also be used to create a Release note in another format if required. 

=item *

Transfer these two files into the package in dpkg_archive

=item *

Insert the packages file list into the Release Manager database.

=back

=item *

Make the package read-only. This will trigger any post-install processing of the 

package. This is only required for packages that form a part of the build system.

=item *

Flag that the package has been released. This may tigger the BLAT package file transfer process 

and the package will be transferred to remote sites.

=item *

Determine the users that have registered interest in being informed when the package is released. 

It will then email these users.

=back

=head1 EXAMPLE

=head2 process_release_notes

This will perform a single scan of the Release Manager database and generate Release Notes as required.

=cut