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;

}