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