Subversion Repositories DevTools

Rev

Rev 1038 | Rev 5404 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 1038 Rev 1042
Line 7... Line 7...
7 
# Compiler(s)   : Perl
 7 
# Compiler(s)   : Perl
8 
# Environment(s):
 8 
# Environment(s):
9 
#
 9 
#
10 
# Description   : Generate a package list
 10 
# Description   : Generate a package list
11 
#                 Format
 11 
#                 Format
12 
#                   Time GMT( gmtTime ) Pname/Pver
 12 
#                   item="value"
13 
#                 Where
 13 
#                 Valid items include
14 
#                   Time            - Time in seconds since the epoch of
 14 
#                   time            - Time in seconds since the epoch of
15 
#                                     the packages descpkg file
 15 
#                                     the packages descpkg file
16 
#                   gmtTime         - Same as Time, except in text form
 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
17 
#                   Pname           - Package Name
 21 
#                   pname           - Package Name
18 
#                   Pver            - Package Version
 22 
#                   pver            - Package Version
19 
#
 - 
 
- 
 
 23 
#                   link            - Package Version is a link. Link target
- 
 
 24 
#                   broken          - Broken link
- 
 
 25 
#                   deleted         - Version marked for deletion
20 
# Usage:
 26 
#                                     Specified days ago.
21 
#
 27 
#
22 
#......................................................................#
 28 
#......................................................................#
23 
 
 29 
 
24 
require 5.008_002;
 30 
require 5.008_002;
25 
use strict;
 31 
use strict;
26 
use warnings;
 32 
use warnings;
27 
 
 33 
 
28 
my $dpkg = "./dpkg_archive";
 34 
my $dpkg = "$ENV{HOME}/dpkg_archive";
29 
 
 35 
 
30 
opendir(DIR, $dpkg) || die "can't opendir $dpkg: $!";
 36 
opendir(DIR, $dpkg) || die "can't opendir $dpkg: $!";
31 
my @dlist = readdir(DIR);
 37 
my @dlist = readdir(DIR);
32 
closedir DIR;
 38 
closedir DIR;
33 
 
 39 
 
34 
foreach my $pname ( sort @dlist )
 40 
foreach my $pname ( sort @dlist )
35 
{
 41 
{
36 
    next if ( $pname eq '.' );
 42 
    next if ( $pname eq '.' );
37 
    next if ( $pname eq '..' );
 43 
    next if ( $pname eq '..' );
- 
 
 44 
    next if ( $pname eq '.dpkg_archive' );
38 
    my $dir = $dpkg . '/'. $pname;
 45 
    my $dir = $dpkg . '/'. $pname;
39 
    next unless ( -d $dir );
 46 
    next unless ( -d $dir );
40 
 
 47 
 
41 
    opendir(DIR, $dir )|| die "can't opendir $dir: $!";
 48 
    opendir(DIR, $dir )|| die "can't opendir $dir: $!";
42 
    my @vlist = readdir(DIR);
 49 
    my @vlist = readdir(DIR);
Line 46... Line 53...
46 
    {
 53 
    {
47 
        next if ( $vname eq '.' );
 54 
        next if ( $vname eq '.' );
48 
        next if ( $vname eq '..' );
 55 
        next if ( $vname eq '..' );
49 
        next if ( $vname =~ m~\.TMPDIR$~ );
 56 
        next if ( $vname =~ m~\.TMPDIR$~ );
50 
        my $vdir = $dir . '/' . $vname;
 57 
        my $vdir = $dir . '/' . $vname;
51 
        next unless ( -d $vdir );
 58 
#        next unless ( -d $vdir );
52 
        next unless ( -f "$vdir/descpkg" );
 59 
#        next unless ( -f "$vdir/descpkg" );
53 
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 60 
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
54 
            $atime,$mtime,$ctime,$blksize,$blocks) = stat(_);
 61 
            $atime,$mtime,$ctime,$blksize,$blocks) = stat("$vdir/descpkg");
- 
 
 62 
 
- 
 
 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";
- 
 
 80 
    }
- 
 
 81 
}
55 
 
 82 
 
- 
 
 83 
#-------------------------------------------------------------------------------
- 
 
 84 
# Function        : quoteData
- 
 
 85 
#
56 
        print "$mtime GMT(", scalar gmtime $mtime, ") ${pname}/${vname}\n";
 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 . '" ';
57 
    }
 99 
    }
- 
 
 100 
    return '';
58 
}
 101 
}
59 
 
 102 
 
- 
 
 103