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;

my $dpkg = "$ENV{HOME}/dpkg_archive";

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";
    }
}

#-------------------------------------------------------------------------------
# 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 '';
}