Subversion Repositories DevTools

#! /usr/bin/perl

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

# Copyright (C) 2011 Vix-ERG Limited, All rights reserved

#

# Module name   : blatPopulate

# Compiler(s)   : Perl

#

# Description   : Populate the blat tags directories with RM data

#

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

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 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_pname;

my $opt_pver;

my $opt_rtag_id;

my $opt_pkg_id;

my $opt_pv_id;

my $opt_proj_id;

my $opt_tagdir = 'tags';

#

#   Describe config uration 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' => '1h'   , 'fmt' => 'period'},

);

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

# Function        : Mainline Entry Point

#

# Description     :

#

# Inputs          :

#

@args = @ARGV;

my $result = GetOptions (

                "help|h:+"      => \$opt_help,

                "manual:3"      => \$opt_help,

                "verbose:+"     => \$opt_verbose,

                "tagdir=s"      => \$opt_tagdir,

                "pname=s"       => \$opt_pname,

                "pver=s"        => \$opt_pver,

                "rtag_id=s"     => \$opt_rtag_id,

                "pkg_id=s"      => \$opt_pkg_id,

                "pv_id=s"       => \$opt_pv_id,

                "proj_id=s"     => \$opt_proj_id,

                );

                #

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

                #

#

#   Process help and manual options

#

pod2usage(-verbose => 0, -message => "blatPopulate") if ($opt_help == 1 || ! $result || $#ARGV >= 0);

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

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

#

#   Set the CWWD 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 );

$logger = Logger->new($conf);

$conf->{logger} = $logger;

$logger->verbose2("Args: @args");

#

#   Sanity Test

#

$logger->err ("pname not provided")    unless ( $opt_pname );

$logger->err ("pver not provided")     unless ( $opt_pver );

$logger->err ("rtag_id not provided")  unless ( $opt_rtag_id );

$logger->err ("pkg_id not provided")   unless ( $opt_pkg_id );

$logger->err ("pv_id not provided")    unless ( $opt_pv_id );

$logger->err ("proj_id not provided")  unless ( $opt_proj_id );

#

#   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~^\.~ );

        my $tagfile = catfile($opt_tagdir, $tag, '.config');

        next unless ( -f $tagfile );

        $logger->verbose2 ("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 ( $data )

        {

#print Dumper($data);

            if (   exists $data->{projects}{$opt_proj_id}

                || exists $data->{releases}{$opt_rtag_id}

                || exists $data->{pkg}{$opt_pname} )

                {

                    TouchFile( catfile( $opt_tagdir, $tag, $opt_pname . '::' . $opt_pver ));

                }

        }

    }

    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);

    }

    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:

    -help              - brief help message

    -help -help        - Detailed help message

    -man               - Full documentation

    -verbose           - A little bit of logging

    -tagdir=path       - Specify alternate tag base

    -...               - Package data

=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.

=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.

=cut