Subversion Repositories DevTools

Rev

Rev 1038 | Rev 5404 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1038 dpurdie 1 
#! /usr/bin/perl
2 
########################################################################
3 
# Copyright (C) 2011 Vix-ERG Limited, All rights reserved
4 
#
5 
# Module name   : flist2.pl
6 
# Module type   :
7 
# Compiler(s)   : Perl
8 
# Environment(s):
9 
#
10 
# Description   : Generate a package list
11 
#                 Format
1042 dpurdie 12 
#                   item="value"
13 
#                 Valid items include
14 
#                   time            - Time in seconds since the epoch of
1038 dpurdie 15 
#                                     the packages descpkg file
1042 dpurdie 16 
#                   GMT             - Same as Time, except in text form
17 
#                   Flags           - Package status flags
18 
#                                       D - marked for deletion
19 
#                                       L - Is a link
20 
#                                       B - Is a broken link
21 
#                   pname           - Package Name
22 
#                   pver            - Package Version
23 
#                   link            - Package Version is a link. Link target
24 
#                   broken          - Broken link
25 
#                   deleted         - Version marked for deletion
26 
#                                     Specified days ago.
1038 dpurdie 27 
#
28 
#......................................................................#
29 
 
30 
require 5.008_002;
31 
use strict;
32 
use warnings;
33 
 
1042 dpurdie 34 
my $dpkg = "$ENV{HOME}/dpkg_archive";
1038 dpurdie 35 
 
36 
opendir(DIR, $dpkg) || die "can't opendir $dpkg: $!";
37 
my @dlist = readdir(DIR);
38 
closedir DIR;
39 
 
40 
foreach my $pname ( sort @dlist )
41 
{
42 
    next if ( $pname eq '.' );
43 
    next if ( $pname eq '..' );
1042 dpurdie 44 
    next if ( $pname eq '.dpkg_archive' );
1038 dpurdie 45 
    my $dir = $dpkg . '/'. $pname;
46 
    next unless ( -d $dir );
47 
 
48 
    opendir(DIR, $dir )|| die "can't opendir $dir: $!";
49 
    my @vlist = readdir(DIR);
50 
    closedir DIR;
51 
 
52 
    foreach my $vname ( sort @vlist )
53 
    {
54 
        next if ( $vname eq '.' );
55 
        next if ( $vname eq '..' );
56 
        next if ( $vname =~ m~\.TMPDIR$~ );
57 
        my $vdir = $dir . '/' . $vname;
1042 dpurdie 58 
#        next unless ( -d $vdir );
59 
#        next unless ( -f "$vdir/descpkg" );
1038 dpurdie 60 
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1042 dpurdie 61 
            $atime,$mtime,$ctime,$blksize,$blocks) = stat("$vdir/descpkg");
1038 dpurdie 62 
 
1042 dpurdie 63 
        $mtime = 0 unless ( $mtime );
64 
 
65 
        my $age = 0;
66 
        $age = -M _ if ( -f "$vdir/.deletepkg" );
67 
 
68 
        my $link = '';
69 
        $link = readlink($vdir) if ( -l $vdir );
70 
 
71 
        print   quoteData('time', $mtime, 1),
72 
                quoteData('GMT', scalar gmtime $mtime, 1),
73 
                quoteData('pname', $pname, 1 ),
74 
                quoteData('pver', $vname,1 ),
75 
                quoteData('deleted', int($age), $age ),
76 
                quoteData('link', $link,  $link  ),
77 
                quoteData('broken', 1, ! -e $vdir  ),
78 
                quoteData('noDescpkg', 1, ! -f "$vdir/descpkg"  ),
79 
                "\n";
1038 dpurdie 80 
    }
81 
}
82 
 
1042 dpurdie 83 
#-------------------------------------------------------------------------------
84 
# Function        : quoteData
85 
#
86 
# Description     : Given an item and data, provided a quoted string
87 
#
88 
# Inputs          : $item
89 
#                   $data
90 
#                   $enable
91 
#
92 
# Returns         : Quoted string
93 
#
94 
sub quoteData
95 
{
96 
    my ($item, $data, $enable) = @_;
97 
    if ( $enable ) {
98 
        return $item . '="' . $data . '" ';
99 
    }
100 
    return '';
101 
}
102 
 
103