Subversion Repositories DevTools

#! /usr/bin/perl
########################################################################
# Copyright (C) 2011 Vix-ERG Limited, All rights reserved
#
# Module name   : flist2.pl
# Module type   :
# Compiler(s)   : Perl
# Environment(s):
#
# Description   : Generate a package list
#                 Format
#                   item="value"
#                 Valid items include
#                   time            - Time in seconds since the epoch of
#                                     the packages descpkg file
#                   GMT             - Same as Time, except in text form
#                   Flags           - Package status flags
#                                       D - marked for deletion
#                                       L - Is a link
#                                       B - Is a broken link
#                   pname           - Package Name
#                   pver            - Package Version
#                   link            - Package Version is a link. Link target
#                   broken          - Broken link
#                   deleted         - Version marked for deletion
#                                     Specified days ago.
#
#......................................................................#

require 5.008_002;
use strict;
use warnings;
use Sys::Hostname;
use Digest::MD5;

my $dpkg = "$ENV{HOME}/dpkg_archive";
my $CountDeleted = 0;
my $CountMissing = 0;
my $CountDamaged = 0;
my $CountTotal = 0;

#
#   MetaData
#   About the disk
#
printMetaData('Hostname', hostname);
insertDiskMetaData($dpkg);

#
#   Package Information
#   
opendir(DIR, $dpkg) || die "can't opendir $dpkg: $!";
my @dlist = readdir(DIR);
closedir DIR;

foreach my $pname ( sort @dlist )
{
    next if ( $pname eq '.' );
    next if ( $pname eq '..' );
    next if ( $pname eq '.dpkg_archive' );
    my $dir = $dpkg . '/'. $pname;
    next unless ( -d $dir );

    opendir(DIR, $dir )|| die "can't opendir $dir: $!";
    my @vlist = readdir(DIR);
    closedir DIR;

    foreach my $vname ( sort @vlist )
    {
        next if ( $vname eq '.' );
        next if ( $vname eq '..' );
        next if ( $vname =~ m~\.TMPDIR$~ );
        my $vdir = $dir . '/' . $vname;
#        next unless ( -d $vdir );
#        next unless ( -f "$vdir/descpkg" );
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
            $atime,$mtime,$ctime,$blksize,$blocks) = stat("$vdir/descpkg");

        $mtime = 0 unless ( $mtime );

        my $age = 0;
        $age = -M _ if ( -f "$vdir/.deletepkg" );

        my $link = '';
        $link = readlink($vdir) if ( -l $vdir );

        print   quoteData('time', $mtime, 1),
                quoteData('GMT', scalar gmtime $mtime, 1),
                quoteData('pname', $pname, 1 ),
                quoteData('pver', $vname,1 ),
                quoteData('deleted', int($age), $age ),
                quoteData('link', $link,  $link  ),
                quoteData('broken', 1, ! -e $vdir  ),
                quoteData('noDescpkg', 1, ! -f "$vdir/descpkg"  ),
                "\n";

        #
        #   Update statistics
        #
        $CountTotal++;   
        $CountDeleted++ if ($age);
        $CountMissing++ if (! -e $vdir);
        $CountDamaged++ if (! -f "$vdir/descpkg");
    }
}

#
#   Data about blats internal files
#   
insertBlatFiles();

#
#   Output summary data as MetaData
#
printMetaData('Total',$CountTotal);
printMetaData('Delete',$CountDeleted);
printMetaData('Missing',$CountMissing);
printMetaData('Damaged',$CountDamaged);

#-------------------------------------------------------------------------------
# Function        : quoteData
#
# Description     : Given an item and data, provided a quoted string
#
# Inputs          : $item
#                   $data
#                   $enable
#
# Returns         : Quoted string
#
sub quoteData
{
    my ($item, $data, $enable) = @_;
    if ( $enable ) {
        return $item . '="' . $data . '" ';
    }
    return '';
}

#-------------------------------------------------------------------------------
# Function        : printMetaData 
#
# Description     : Add metadata to the output stream
#
# Inputs          : name        - Name of the data
#                   value       - Value
#
# Returns         : 
#
sub printMetaData
{
    my ($name,$value) = @_;
    print('Metadata ', quoteData($name, $value, 1), "\n");
}

#-------------------------------------------------------------------------------
# Function        : insertBlatFiles 
#
# Description     : Insert data about the BLAT files
#
# Inputs          : None. 
#
# Returns         : Nothing
#
sub insertBlatFiles
{
    my $blatDir = "$ENV{HOME}/bin";
    if (opendir(DIR, $blatDir ) ) {
        my @vlist = readdir(DIR);
        closedir DIR;

        foreach my $vname ( sort @vlist )
        {
            next if ( $vname eq '.' );
            next if ( $vname eq '..' );
            next unless ( -f "$blatDir/$vname" );
            my $md5 = "FileReadError";

            if (open FILE, "$blatDir/$vname") {
                $md5 = Digest::MD5->new->addfile (*FILE)->hexdigest;
                close (FILE);
            }
            print   'BlatBin ',
                    quoteData('MD5', $md5, 1),
                    quoteData('file', $vname, 1 ),
                    "\n";
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : insertDiskMetaData  
#
# Description     : Generates Disk Metadata entries in the output stream
#                   Keys are: 
#                       size   used  avail  pcent 
#                       itotal iused iavail ipcent 
#
#                   Needs to use basic 'df' functionality. Not all targets
#                   will have a full gnu implementation. 
#
# Inputs          : $path       - Path somewhere on the drive to examine
#
# Returns         : Nothing
#
sub insertDiskMetaData
{
    my ($path) = @_;

    #
    #   Get disk information
    #
    my @items = qw(- size used avail pcent -);
    open my $dfData , "-|", "df", '-P', $path;
    while (<$dfData>)
    {
        next if $. < 2;
        s~\s+$~~;
        s~\%~~g;
        my @data = split;

        for (my $ii=0; $ii <= $#items; $ii++)
        {
            next if $items[$ii] eq '-';
            printMetaData( $items[$ii], $data[$ii]);
        }
    }
    close $dfData;

    #
    #   Get Inode information
    #   Disk can fill up if inodes are depleated
    #
    @items = qw(- isize iused iavail ipcent -);
    open $dfData , "-|", "df", '-Pi', $path;
    while (<$dfData>)
    {
        next if $. < 2;
        s~\s+$~~;
        s~\%~~g;
        my @data = split;

        for (my $ii=0; $ii <= $#items; $ii++)
        {
            next if $items[$ii] eq '-';
            printMetaData($items[$ii], $data[$ii]);
        }
    }
    close $dfData;
}