head	1.1;
branch	1.1.1;
access;
symbols
	import-20090318:1.1.1.9
	import-20081205:1.1.1.8
	rel-8-1-2-sv:1.1.1.8
	import-20080404:1.1.1.8
	import-20071105:1.1.1.7
	import-20070116:1.1.1.6
	import-20061124:1.1.1.5
	rel-6-2-2-sv:1.1.1.5
	rel-6-2-1-sv:1.1.1.5
	import-20060615:1.1.1.5
	import-20060530:1.1.1.5
	import-20060516:1.1.1.5
	import-20060421:1.1.1.4
	import-20060406:1.1.1.3
	import-29mar06:1.1.1.2
	import-14mar06:1.1.1.1
	import-13mar06:1.1.1.1
	fixed-post-import-14feb06:1.1.1.1
	import-14feb06:1.1.1.1
	fixed-post-import-6feb06:1.1.1.1
	import-6feb06:1.1.1.1
	freescale:1.1.1;
locks; strict;
comment	@# @;


1.1
date	2006.02.06.14.20.04;	author seh;	state Exp;
branches
	1.1.1.1;
next	;

1.1.1.1
date	2006.02.06.14.20.04;	author seh;	state Exp;
branches;
next	1.1.1.2;

1.1.1.2
date	2006.03.29.14.43.12;	author seh;	state Exp;
branches;
next	1.1.1.3;

1.1.1.3
date	2006.04.06.14.36.27;	author seh;	state Exp;
branches;
next	1.1.1.4;

1.1.1.4
date	2006.04.21.10.02.33;	author seh;	state Exp;
branches;
next	1.1.1.5;

1.1.1.5
date	2006.05.16.14.20.54;	author seh;	state Exp;
branches;
next	1.1.1.6;

1.1.1.6
date	2007.01.17.10.48.14;	author seh;	state Exp;
branches;
next	1.1.1.7;

1.1.1.7
date	2007.11.06.15.44.44;	author seh;	state Exp;
branches;
next	1.1.1.8;
commitid	AdKoH3Xx8FxdUwEs;

1.1.1.8
date	2008.04.04.10.51.54;	author seh;	state Exp;
branches;
next	1.1.1.9;
commitid	GVikqE6sLnKPsMXs;

1.1.1.9
date	2009.03.18.17.53.28;	author seh;	state Exp;
branches;
next	;
commitid	2ZWvH4Ejl9NUBxGt;


desc
@@


1.1
log
@Initial revision
@
text
@eval 'LANG=C exec perl -w -S $0 ${1+"$@@"}'
    if $running_under_some_shell;
$running_under_some_shell = 0;

######################################################################
#
# Copyright  Freescale Semicondutor, Inc. 2004-2005. All rights reserved.
#
# Stuart Hughes, stuarth@@freescale.com,  6th May 2005
#   
# This file is part of LTIB.
#
# LTIB is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# LTIB is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LTIB; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#
#
# List information about package sources and patches,
# the stdout is normally redirected to LtibPppInfoSpecXref
#
######################################################################
use File::Find;
use Getopt::Std;
use Cwd 'realpath';
use FindBin;
use lib("$FindBin::Bin");
use Ltibutils;

$top = "$FindBin::Bin/..";
$toplen = length(realpath($top)) + 1;
$opt_h = 0;
$opt_v = 0;
$opt_x = 1;

$lpp  = "/opt/freescale/pkgs";
@@dirs = map { realpath($_) } ("$top/rpm/SPECS",
                              "$top/dist/lfs-5.1",
                              "$top/dist/FC-2",
                              "$top/config/platform");

$usage = <<TXT;
Usage  listpkgs [ -v|-u|-h ]
  Note the cross reference goes to stdout, so redirect this to a file
  Where:
    -v          : verbose
    -h          : show usage
TXT

getopts('hvux') or die($usage);
die($usage) if $opt_h;

# look in spec files for sources and patches
find( \&spec_sources, @@dirs);

# look in config files for toolchain rpm files
find( \&config_rpms, realpath("$top/config/platform"));

# output the main results
header();

foreach $parent ( sort keys %$xref ) {
    print "\n---++ ", $parent, "\n" if $opt_x || $opt_v;
    foreach $fn ( @@{$xref->{$parent}} ) {
        $esc_fn = unpack("H*", $fn . '.html');
        print "[[$esc_fn][$fn]]<br>\n" if $opt_x || $opt_v;
    }    
}

trailer();

# opt_v list unreferenced files to stderr
exit(0) unless $opt_v;
warn "\n\n---++ Unreferenced files in $lpp\n";
foreach (glob("$lpp/*")) {
    next if m,\.md5$,;
    ($fn) = m-/?([^/]+)$-;
    warn "$fn\n" unless exists $found->{$fn};
}
exit(0);

sub spec_sources
{
    return unless m,\.spec$,;
    my $rel = substr($File::Find::name, $toplen);
    my $tok = { sources => "", patches => "" };
    parse_spec($File::Find::name, $tok);
    foreach my $url (  split(/\s*\n/, $tok->{sources}),
                       split(/\s*\n/, $tok->{patches})   ) {
        my ($fn)   = $url =~ m-/?([^/]+)$-;
        push @@{$xref->{$rel}}, $fn;
        $found->{$fn} = -f "$lpp/$fn" ? 'cached  ' : 'missing ';
        warn "$found->{$fn}: $fn\n" if $opt_v;
    }
}

sub config_rpms
{
    return unless m,\.lkc$,;
    my $rel = substr($File::Find::name, $toplen);
    open(LKC, $File::Find::name) or die "open $File::Find::name\n";
    while(<LKC>) {
        my ($fn) = m,([-\.\w]+\.i686\.rpm),;
        next unless $fn; 
        push @@{$xref->{$rel}}, $fn;
        $found->{$fn} = -f "$lpp/$fn" ? 'cached  ' : 'missing ';
        warn "$found->{$fn}: $fn\n" if $opt_v;
    }
}

sub header
{
    print <<TXT;
%TOPICTITLE%
---

%TOC%

---+ LTIB source/patch cross reference


TXT
}

sub trailer
{
    print <<TXT;

---
Autogenerated by listpkginfo on: ${\  ( scalar gmtime() )}  GMT
TXT
}
@


1.1.1.1
log
@Import from fsl 6feb06
@
text
@@


1.1.1.2
log
@Import from fsl 29mar06
@
text
@d41 4
d47 1
a47 1
                              "$top/dist/lfs-5.1/kernel",
a58 4
# option handling
$opt_h = 0;
$opt_v = 0;

a61 3
# build a list of spec files and the things that references them
find( \&build_spec_refs, @@dirs);

d70 4
a73 8
foreach $referer ( sort keys %$xref ) {
    print "\n---++ $referer\n";
    if( ($spec) = $referer =~ m,/([^/]+)\.spec$, ) {
        foreach $parent ( @@{$specref->{$spec}} ) {
            print "   * referenced by: $parent\n";
        }
    }
    foreach $fn ( @@{$xref->{$referer}} ) {
d75 2
a76 2
        print "[[$esc_fn][$fn]]<br>\n";
    }
d78 1
a90 27

sub build_spec_refs
{
    my $name = $_;
    my $pre;
    $pre = '^[\w]+\s*=\s*([\S]+)' if $name eq 'pkg_map';
    $pre = '^\s*default\s+"?((?:u-boot|kernel|blob)-[^\s"]+)'
                                    if $name =~ m,\.lkc$,;
    return unless $pre;

    my $rel = substr($File::Find::name, $toplen);
    my $seen = {};
    warn "\n$rel\n" if $opt_v;
    local $/ = undef;
    open(FN, $File::Find::name) or die "open $File::Find::name\n";
    local $_ = <FN>;

    while( m,$pre,mg ) {
            next if defined $seen->{$1};
            next if $1 =~ m,\.config$,;
            push @@{$specref->{$1}}, $rel;
            $seen->{$1} = 1;
            warn "\t$1\n" if $opt_v;
    }
    close FN;
}

a93 2
    s,.spec$,,;
    return unless exists $specref->{$_};
d110 7
a116 11
    my $seen = {};
    warn "\n$rel\n" if $opt_v;
    local $/ = undef;
    open(FN, $File::Find::name) or die "open $File::Find::name\n";
    local $_ = <FN>;
    while(m,([-\.\w]+\.i\d86\.rpm),mg ) {
        next if defined $seen->{$1};
        push @@{$xref->{$rel}}, $1;
        $seen->{$1} = 1;
        $found->{$1} = -f "$lpp/$1" ? 'cached  ' : 'missing ';
        warn "$found->{$1}: $1\n" if $opt_v;
a117 1
    close FN;
@


1.1.1.3
log
@Import from fsl 20060406
@
text
@d43 1
a43 1
                              "$top/dist/lfs-5.1",
@


1.1.1.4
log
@Import from fsl 20060421
@
text
@d42 1
a42 1
@@dirs = grep { realpath($_) } ("$top/rpm/SPECS",
@


1.1.1.5
log
@Import from fsl 20060516
@
text
@d7 1
a7 1
# Copyright  Freescale Semiconductor, Inc. 2004-2005. All rights reserved.
d75 1
a75 1
    if( ($spec) = $referer =~ m,/([^/]+)\.spec(?:\.in)?$, ) {
d126 2
a127 2
    return unless m,\.spec(?:\.in)?$,;
    s,.spec.*$,,;
@


1.1.1.6
log
@Import from fsl 20070116
@
text
@d151 5
a155 10
        my ($rpm, $srpm) = ($1);
        next if defined $seen->{$rpm};
        $seen->{$rpm} = 1;
        push @@{$xref->{$rel}}, $rpm;
        ($srpm = $rpm) =~ s,\.i\d86\.rpm,.src.rpm,;
        push @@{$xref->{$rel}}, $srpm;
        $found->{$rpm}  = -f "$lpp/$rpm"  ? 'cached  ' : 'missing ';
        $found->{$srpm} = -f "$lpp/$srpm" ? 'cached  ' : 'missing ';
        warn "$found->{$rpm}: $rpm\n"   if $opt_v;
        warn "$found->{$srpm}: $srpm\n" if $opt_v;
@


1.1.1.7
log
@Import from fsl 20071105
@
text
@a0 1
#!/usr/bin/perl -w
d7 1
a7 1
# Copyright  Freescale Semiconductor, Inc. 2004-2007. All rights reserved.
d44 2
a45 2
                              "$top/config/platform",
                              "$top/config/userspace");
d48 2
a49 1
Usage  listpkgs -r <ref> -f <file> -v -h 
a50 2
    -r          : reference (spec) file
    -f          : output file
a55 2
$opt_r = '';
$opt_f = '';
d59 1
a59 1
getopts('r:f:hv') or die($usage);
a60 6
if($opt_f) {
    open(STDOUT, ">$opt_f") or die("can't redirect stderr to $opt_f: $!");
    chmod(0666, $opt_f);
    $| = 1;
    $SIG{__WARN__} = \&warn_handler;
}
d69 1
a69 1
find( \&config_rpms, realpath("$top/config/platform")) unless $opt_r;
d74 1
a74 2
    ($pval = $referer) =~ s,^bin/\.\./,,;
    print "\n---++ $pval\n";
d77 1
a77 2
            ($pval = $parent) =~ s,^bin/\.\./,,;
            print "   * referenced by: $pval\n";
a86 5
print "unreferenced spec files:\n";
foreach $spec ( sort keys %$unref ) {
    print "$spec\n";
}

d106 1
a125 1
    return if $opt_r && $_ ne $opt_r;
d128 1
a128 1
    $unref->{$_} += 1, return unless exists $specref->{$_};
a186 11

my $ctr = 0;
sub warn_handler
{
    print STDERR '.';
    if($ctr++ > 78) {
        $ctr = 0;
        print STDERR "\n";
    }
}

@


1.1.1.8
log
@Import from fsl 20080404
@
text
@d147 2
a148 1
    my $tok = parse_spec($File::Find::name) or die();
@


1.1.1.9
log
@Import from fsl 20090318
@
text
@a31 22
#
# The internal data structure built is of the form:
#
# $specs = {
#     $sn1 => {
#           path => rel_path
#           srcs => [ s1, s2, p1, p2,  ..,],
#           keys => { $key1 => [ $ref, ...], 
#                     $key2 ...  
#           }
#     },
#     $sn2 => {....
#     }, ...
# };
#
# The bkeys hash is used to store boolean key references only
# $bkeys  = {
#     $key1 => $ref,
#      ...
# };
#
#
d41 6
a46 1
$bogs = $remaps = $unsel = $unref = $prvs = '';
a47 6
$opt_l = '';
$opt_f = '';
$opt_r = '';
$opt_b = 0;
$opt_p = '';
$opt_h = 0;
d49 1
a49 1
Usage  listpkgs [ -r <ref> -f <file> ] [ options....]
d51 3
a53 5
    -l dir      : ltib directory to scan (hint branches)
    -f path     : send normal stdout to path and redirect stderr stdout
    -r pkg.spec : reference (spec) file name (not path)
    -p          : limit to this platform (e.g mpc7448hpcii)
    -b          : basic output
d58 6
a63 1
getopts('l:f:r:p:bh') or die($usage);
d65 6
a70 4
die("-p option not implemented yet\n") if $opt_p;
$top    = $opt_l if $opt_l;
$top    = realpath($top);
$toplen = length(realpath($top)) + 1;
d72 2
a73 5
# build directory list to scan
@@dirs = grep { realpath($_) } ("$top/rpm/SPECS",
                              "$top/dist/lfs-5.1",
                              "$top/config/platform/$opt_p");
push @@dirs, realpath("$top/config/userspace") unless $opt_p;
d75 2
a76 2
# redirect if opt_f
redir($opt_f) if $opt_f;
d78 2
a79 15
# find all .spec and .spec.in files
warn("Finding all spec files\n");
find(\&all_specs, @@dirs);

# build a list of references from map files
warn("Building a list of references from map files\n");
find(\&build_map_refs, realpath("$top/config"));

# build a list of references from config files
warn("Building a list of references from lkc files\n");
find(\&build_spec_refs, realpath("$top/config"));

# look in spec files for sources and patches
warn("Building a list of spec file sources and patches\n");
find(\&spec_sources, @@dirs);
d81 1
a81 3
#
# output the main results and build warnings
#
d83 7
a89 48
foreach $lkc (keys %$tcs) {
    last if $opt_r || $opt_p;
    $msg  = "\n---++ $lkc\n";
    foreach $fn (@@{$tcs->{$lkc}}) {
        $msg .= "      * $fn\n", next if $opt_b;
        $esc_fn = unpack("H*", $fn . '.html');
        $msg .= "[[$esc_fn][$fn]]<br>\n";
    }
    print $msg;
}
foreach $sn (sort keys %$specs) {
    die("null key in specs hash\n") unless $sn;
    $path = $specs->{$sn}{path};
    @@srcs = ();
    @@srcs = @@{$specs->{$sn}{srcs}} if $specs->{$sn}{srcs};
    @@keys = keys %{$specs->{$sn}{keys}};
    
    if(! $path) {
        $bogs .= "$sn:\n";
        foreach $key (@@keys) {
            $bogs .= "    $key: " . ' ' x (25 - length($key));
            $bogs .=  join(' ',  @@{$specs->{$sn}{keys}{$key}}) . "\n";
        }
        next;
    }
    $unref .= "$path\n", next unless @@keys;

    if(@@keys > 1) {
        $remaps .= "$sn:\n";
        foreach $key (@@keys) {
            $remaps .= "    $key: " . ' ' x (25 - length($key));
            $remaps .= join(' ', @@{$specs->{$sn}{keys}{$key}}) . "\n";
        }
    }

    $has_prvs = 0;
    $has_maps = 0;
    $has_lkcs = 0;
    ($pdir) = $path =~ m,^(config/platform/[^/]+),;
    $msg  = "\n---++ $path\n";

    foreach $key (@@keys) {
        foreach $ref (@@{$specs->{$sn}{keys}{$key}}, $bkeys->{$key}) {
            next unless $ref;
            $has_prvs++ if $pdir && $ref !~ m,^$pdir,;
            $has_maps++ if $ref =~ m,pkg_map[\w-]*$,;
            $has_lkcs++ if $ref =~ m,\.lkc$,;
            $msg .= "   * referenced by: $ref\n";
d92 1
a92 3
    foreach $fn (@@srcs) {
        last unless $has_lkcs;
        $msg .= "      * $fn\n", next if $opt_b;
d94 1
a94 1
        $msg .= "[[$esc_fn][$fn]]<br>\n";
a95 3
    $unsel .= $msg unless $has_lkcs;
    $prvs  .= $msg if $has_prvs;
    print $msg if $has_lkcs;
d99 3
a101 9
#
# output errors and warnings to stderr
#
exit(0) if $opt_r || $opt_f;
if(defined $dups) {
    warn("\n---++ Error: duplicate spec files\n");
    foreach $sn (sort keys %$dups) {
        warn("$sn: ", join(" ", @@{$dups->{$sn}}), "\n");
    }
a102 11
warn("\n---+ Error: conflicting keys mappings:\n$remaps")          if $remaps;
warn("\n---+ Error: private spec with bad refs\n", $prvs, "\n")    if $prvs;
warn("\n---+ Spec files not in the config system\n", $unsel, "\n") if $unsel;
warn("\n---+ Unmapped spec files:\n$unref", )                      if $unref; 
warn("\n---+ Possible bogus spec name references:\n", $bogs)       if $bogs;
exit(0);


###########################
# functions
###########################
d104 7
a110 9
sub all_specs
{
    return if $opt_r && $_ ne $opt_r;
    return unless m,\.spec(?:\.in)?$,;
    s,.spec.*$,,;
    my $rel  = substr($File::Find::name, $toplen);
    push( @@{$dups->{$_}}, ($specs->{$_}{path}, $rel)),
                                           return if exists $specs->{$_}{path};
    $specs->{$_}{path} = $rel;
d112 1
a113 13
sub build_map_refs
{
    return unless m,^pkg_map[\w-]*(?!\.bak),;
    my $rel = substr($File::Find::name, $toplen);
    open(FN, $File::Find::name) or die("open $File::Find::name\n");
    while(<FN>) {
        if( m,^(PKG_\w+)\s*=\s*([\S]*), ) {
            next unless $2;
            push(@@{$specs->{$2}{keys}{$1}}, $rel);
        }
    }
    close(FN);
}
d117 6
a122 2
    return unless m,\.lkc$,;
    my (%list, @@list, $tok, $tc);
d124 12
a135 25
    open(FN, $File::Find::name) or die("open $File::Find::name\n");
    while(<FN>) {
        if( my $nr =    /^\s*config\s+(?:TOOLCHAIN\b|PKG_)(?!\w+PRECONFIG\s*$)/ 
                  ... ! /^\s*(?:string|default)/ ) {
            if($nr == 1) {
                ($tok) = /^\s*config\s+(\w+)/;
                $tc    = /TOOLCHAIN/;
                %list  = ();
            }
            if($nr =~ /E0$/) {
                @@list = keys %list; 
                $bkeys->{$tok} = $rel if ! @@list && ! $bkeys->{$tok};
                foreach my $sn (@@list) {
                    next if $sn =~ m,(?:_(?:def)?config)$,;
                    if($tc) {
                        push(@@{$tcs->{$rel}}, $sn);
                        $sn =~ s,\.i\d86\.rpm$,.src.rpm,;
                        push(@@{$tcs->{$rel}}, $sn);
                        next;
                    }
                    push(@@{$specs->{$sn}{keys}{$tok}}, $rel);
                }
            }
            $list{$2} = 1 if /^\s*default\s+("?)([\w.-]+)\1/;
        }
d137 1
a137 2
    close(FN);
    return;
d145 1
d147 1
a147 3
    return unless exists $specs->{$_}{path} && $specs->{$_}{path} eq $rel; 

    my $tok = parse_spec($File::Find::name) or return;
d150 4
a153 3
        (undef, $url) = split(/:\s*/, $url, 2);
        my ($fn) = $url =~ m-/?([^/]+)$-;
        push(@@{$specs->{$_}{srcs}}, $fn);
d157 24
d191 1
d204 2
a205 1
sub redir
d207 5
a211 6
    my ($of) = @@_ or die;
    open(SAVEOUT, ">&STDOUT");
    open(STDOUT, ">$of") or die("can't redirect stderr to $of: $!");
    chmod(0666, $of);
    $| = 1;
    $SIG{__WARN__} = sub { print SAVEOUT @@_ }; 
d213 1
@


