Subversion Repositories DevTools

#! /usr/bin/perl
########################################################################
# Copyright (C) 1998-2011 Vix Technology, All rights reserved
#
# Module name   : blatPopulate
# Compiler(s)   : Perl
#
# Description   : Populate the blat tags directories with RM data
#                 See POD at end of this file
#
#......................................................................#

require 5.008_002;
use strict;
use warnings;

use Getopt::Long;                               # Option processing
use Pod::Usage;                                 # Required for help support

use File::Basename;
use File::Spec::Functions qw(catfile);
use FindBin;

use FindBin;                                    # Determine the current directory
use lib "$FindBin::Bin/lib";                    # Allow local libraries
use Utils;
use StdLogger;                                  # Log to sdtout
use Logger;

use Data::Dumper;

#
#   Globals
#
my $rootDir = $FindBin::Bin;
my $configPath = "config/blatPopulate.cfg";
my $conf;
my $errors;
my $logger;
my @args;

#
#   Options
#
my $opt_help = 0;
my $opt_verbose = 0;
my $opt_tagdir = 'tags';
my $opt_nodaemonise;

my %pkginfo;


#
#   Describe configuration parameters
#
my %cdata = (
    'logfile'         => {'mandatory' => 1    , 'fmt' => 'vfile'},
    'logfile.size'    => {'default' => '1M'   , 'fmt' => 'size'},
    'logfile.count'   => {'default' => 9      , 'fmt' => 'int'},
    'verbose'         => {'default' => 0      , 'fmt' => 'int'},
    'tagdir'          => {'mandatory' => 1    , 'fmt' => 'dir'},
    'maxFileAge'      => {'default' => '24h'  , 'fmt' => 'period'},
);

#-------------------------------------------------------------------------------
# Function        : Mainline Entry Point
#
# Description     :
#
# Inputs          :
#
@args = @ARGV;
Getopt::Long::Configure('pass_through');
my $result = GetOptions (
                "help|h:+"      => \$opt_help,
                "manual:3"      => \$opt_help,
                "verbose:+"     => \$opt_verbose,
                "tagdir=s"      => \$opt_tagdir,
                "D"             => \$opt_nodaemonise,
                
                );

                #
                #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
                #

#
#   Process help and manual options
#
pod2usage(-verbose => 0, -message => "blatPopulate") if ($opt_help == 1 || ! $result );
pod2usage(-verbose => 1) if ($opt_help == 2 );
pod2usage(-verbose => 2) if ($opt_help > 2);

$logger = StdLogger->new();

#
#   Set the CWD as the directory of the script
#   This simplifies configuration and use
#
chdir ($rootDir) || die ("Cannot 'cd' to $rootDir: $!\n");

#
#   Read in config
#
($conf, $errors) = Utils::readconf ( $configPath, \%cdata );
if ( scalar @{$errors} > 0 )
{
    warn "$_\n" foreach (@{$errors});
    die ("Config contained errors\n");
}

$conf->{verbose} = $opt_verbose if ( $opt_verbose > 0 );
unless ( $opt_nodaemonise )
{
    $logger = Logger->new($conf);
    $conf->{logger} = $logger;
}
$logger->verbose2("Args: @args");

#
#   Porcess command line
#   Arguments are of the form aaaa=bbbbm
#
foreach ( @ARGV )
{
    next unless ( m~(.+)=(.+)~ );
    {
        my $tag = $1;
        my $value = $2;
        $value =~ s~^['"]~~;
        $value =~ s~['"]$~~;
        $pkginfo{$tag} = $value;
    }
}

#
#   Sanity Test
#   Ensure required arguments have been presented
#
foreach  ( qw(pkg_name pkg_version rtag_id pkg_id pv_id proj_id mode_id) )
{
    $logger->err ("$_ not provided")    unless ( exists $pkginfo{$_} );

}

#
#   Not interested in package deletions
#
if ( $pkginfo{mode_id} == 2 )
{
    $logger->verbose3 ("Ignore package deletion: $pkginfo{pkg_name},$pkginfo{pkg_version}");
    exit 0;
}

#
#   Examine all the tag subdirectories
#   They will have a configuration file in them that has been created by the
#   consumer daemon.
#

    my $dh;
    unless (opendir($dh, $opt_tagdir) )
    {
        $logger->err ("Can't opendir $opt_tagdir: $!");
    }

    #
    #   Process each entry
    #       Ignore those that start with a .
    #       Only process subdirs
    #
    while (my $tag = readdir($dh) )
    {
        next if ( $tag =~ m~^\.~ );
        $logger->verbose3 ("Processing: $tag");
        my $tagfile = catfile($opt_tagdir, $tag, '.config');
        next unless ( -f $tagfile );
        $logger->verbose3 ("Tag Dir: $tagfile");

        my ($mtime) = Utils::mtime($tagfile);
        my $age = time() - $mtime;
        $logger->verbose3( "Config File Age: $age, $conf->{maxFileAge}");
        if ( $age > $conf->{maxFileAge} )
        {
            $logger->verbose ("File is OLD: $tagfile, $age");
            unlink $tagfile;
            next;
        }

        #
        #   Read in the config file
        #   Items of interest are:
        #       project
        #       release
        #       pkg.Name
        #
        my $data = ConfigReader::readConfig($tagfile);
        if ( $conf->{verbose} > 2 )
        {
            $logger->verbose3 ("Config: " . Dumper($data));
        }
        if ( $data )
        {
            if (   ( exists $data->{allArchive} && $data->{allArchive} )
                || ( exists $data->{allProjects} && $data->{allProjects} ) 
                ||   exists $data->{projects}{$pkginfo{proj_id}}
                ||   exists $data->{releases}{$pkginfo{rtag_id}}
                ||   exists $data->{pkg}{$pkginfo{pkg_name}} )
                {
                    TouchFile( catfile( $opt_tagdir, $tag, $pkginfo{pkg_name} . '::' . $pkginfo{pkg_version} ));
                }
        }
    }
    closedir $dh;

#-------------------------------------------------------------------------------
# Function        : TouchFile 
#
# Description     : touch a file
#                   Real use is to touch a marker file
#
# Inputs          : path        - path to the file
#
# Returns         : TRUE if an error occured in creating the file
#
sub TouchFile
{
    my ($path) = @_;
    my $result = 0;
    my $tfh;
    $logger->verbose( "Touching: $path" );
    if ( ! -f $path )
    {
        open ($tfh, ">>", $path) || ($result = 1);
        close $tfh;
    }
    else
    {

        #
        #   Modify the file
        #
        #   Need to physically modify the file
        #   Need to change the 'change time' on the file. Simply setting the
        #   last-mod and last-access is not enough to get past WIN32
        #   OR 'utime()' does not work as expected
        #
        #   Read in the first character of the file, rewind and write it
        #   out again.
        #
        my $data;
        open ($tfh , "+<", $path ) || return 1;
        if ( read ( $tfh, $data, 1 ) )
        {
            seek  ( $tfh, 0, 0 );
            print $tfh $data;
        }
        else
        {
            #
            #   File must have been of zero length
            #   Delete the file and create it
            #
            close ($tfh);
            unlink ( $path );
            open ($tfh, ">>", $path) || ($result = 1);
        }
        close ($tfh);
    }

    #
    #   Ensure all can remove the file
    #   May be created by root and need to be deleted by the blatDaemon
    #
    chmod 0666, $path;
    return $result;
}

package ConfigReader;
our %config;

#-------------------------------------------------------------------------------
# Function        : readConfig
#
# Description     : Read in a configuration file
#                   The file is a perl data structure and it can be
#                   required directly
#
# Inputs          : $fname              - Name of the file to read
#
# Returns         : Data component of the file
#
sub readConfig
{
    my ($fname) = @_;
#print "Reading: $fname\n";
    require $fname;
    return \%config;
}

#-------------------------------------------------------------------------------
#   Documentation
#

=pod

=head1 NAME

blatPopulate - Populate Blats tags directory to provide fast-transfer of packages

=head1 SYNOPSIS

blatPopulate [options] pkg_data


 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -verbose           - A little bit of logging
    -tagdir=path       - Specify alternate tag base
 PkgData
    tag=value          - A list of package information items

=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<-tagdir=path>

This provides an alternate tag directory root. The default value is a 'tags'
directory located below the directory in which the program is located.

=item B<-tagdir=path>

A list of package information items. These include:

=over 4

=item * archive

=item * pkg_name

=item * pkg_version

=item * rtag_id

=item * pkg_id

=item * pv_id

=item * proj_id

=item * mode_id

=back

=back

=head1 DESCRIPTION

This utility is designed to be invoked by Release Manager when a new package
has been added to a release.

The function of this program is to determine which Blat transfer targets
need to be notified of this event. This is done by

=over 8

=item * Scanning all tag directories for a .config file

=item * Examining the .config file and if the transfer target needs the current
        package then a tag file will be created.

=back

The .config file is created by the the consume BlatDaemon on a regular basis.
If the file is too old it will be deleted, on the assumption that the
blatDaemon is dead.

=head2 EXAMPLE

    blatPopulate.pl  archive=dpkg_archive
                     pkg_name='h400sdk'
                     pkg_version='1.1.13-4.1000.cots'
                     rtag_id=11083
                     pkg_id=32885
                     pv_id=270088
                     proj_id=341
                     mode_id=2
                     -verbose=3

=cut