#!/usr/bin/perl

# Copyright (c) 2001 "Brandon L. Golm" <br@ndon.com>
# All rights reserved.
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself provided this message and author
# information are retained.

# Note the embedded modules (that may, or may not, end up being further
# developed and added to CPAN -- under different names).
# Thereby: this script only requires a standard Perl and CVS install.

$VERSION='0.9';

package RefWatch;
require Carp;

$VERSION = 0.01;

sub new {
    my $proto = shift;
    my $meclass = ref($proto) || $proto;
    my $class = $meclass;
    if (my $bclass = shift) {
        eval "\@RefWatch::${bclass}::ISA = ('$meclass')";
        $class = "${meclass}::${bclass}";
    }
    my $a = 1;
    my $r = \$a;
    bless($r,$class);
    return $r;
}

sub DESTROY {
    my $s = shift;
    $s =~ /(?:.+?)::(.*)=/;
    Carp::carp("A $1 was destroyed without explicit close, possible data loss") if ${$s};
}

package PrintTable;
use Carp;

$DEF_FORMAT = {
               align=>'left',
               cell=>[],
               };

$VERSION = 0.01;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my %param = @_;
    if (my $use = delete $param{'-use'}) {
        croak "can not load table view '$use': $@" if $@;
        my @ret = new {"PrintTable::$use"}(%param);
        croak "$@" if $@;
        return wantarray ? @ret : $ret[0];
    }
    my $self  = [{
        nl => defined $param{'-nl'} ? delete $param{'-nl'} : "\n",
        queue => [],
        outf => delete $param{'-outf'} || *STDOUT,
        watch => new RefWatch($class),
    },
                 {%{$DEF_FORMAT}}
                 ];

    bless ($self, $class);
    return $self;
}

sub set_new {
    my $self = shift;
    my %param = @_;

    my $self0 = $self->[0];
    @{$self0->{'queue'}} = ();

    $self0->{'nl'  } = delete $param{'-nl'  } if defined $param{'-nl'  };
    $self0->{'outf'} = delete $param{'-outf'} if defined $param{'-ouf' };
    $self0->{'cols'} = delete $param{'-cols'} if defined $param{'-cols'};

    return $self;
}

sub queue {
    my $self = shift;
    my $q = $self->[0]{'queue'};
    foreach my $c (@_) {
        ref($q->[-1]) || push(@{$q},[]);
        push(@{$q->[-1]},$c);
        push(@{$q},[]) if $self->[0]{'cols'} <= @{$q->[-1]};
    }
    return $self;
}

sub flush {
    my $self = shift;
    return if $self->[0]{'flushing'};
    $self->[0]{'flushing'} = 1;
    while (my $row = shift @{$self->[0]{'queue'}}) {
        $self->row(@{$row});
    }
    $self->[0]{'flushing'} = 0;
    return $self;
}

sub open {
    my $self = shift;
    ${$self->[0]{'watch'}}++ unless ${$self->[0]{'watch'}};
    return $self;
}

sub close {
    my $self = shift;
    ${$self->[0]{'watch'}}-- if ${$self->[0]{'watch'}};
    $self->flush();
    return $self;
}

sub cell {
    my $self = shift;
    $self->queue(shift) while defined $_[0];
    return $self;
}

sub AUTOLOAD {return shift} # silently ignore features missing
                            # from different display drivers

sub DESTROY { }

sub header_row {
    my $self = shift;
    if ($_[0]) {
        $self->[0]{'header_row'} = [@_];
    }
    else {
        return $self->row(@{$self->[0]{'header_row'}});
    }
    return $self;
}

sub nl {
    my $self = shift;
    my $f = $self->[0]{'outf'};
    print $f $self->[0]{'nl'};
    return $self;
}

sub format {
    my $self = shift;
    my ($t,$fmt) = @{$self};
    $fmt = &data_copy($fmt);
    my $cfmt = $fmt->{'cell'};
    carp "format called with odd number of parameters!" if @_ % 2 && $^W;
    my $in;
    while ($in = shift) {
        if ($in eq 'cell') {
            my $ar = shift;
            local $_;
            for (ref($ar)) {
                if (/ARRAY/) {
                    foreach my $i (0 .. $#{$ar}) {
                        foreach my $k (keys %{$ar->[$i]}) {
                            $cfmt->[$i]->{$k} = $ar->[$i]->{$k};
                        }
                    }
                }
                elsif (/HASH/) {
                    foreach my $i (keys %{$ar}) {
                        foreach my $k (keys %{$ar->{$i}}) {
                            $cfmt->[$i]->{$k} = $ar->{$i}->{$k};
                        }
                    }
                }
                else {
                    croak "format cell called with ${\($_||'SCALAR')} instead of HASH or ARRAY";
                }
            }
        }
        else {
            $fmt->{$in} = shift;
        }
    }
    return (bless([$t,$fmt], $self =~ /(.*)\=/ && $1));
    # self gets reconstructed after copy and edit.
}

sub data_copy {
    local $_;
    my @r;
    foreach my $e (@_) {
        for (ref($e)) {
            if(/ARRAY/) {
                push @r, [&data_copy(@{$e})];
            }
            elsif (/HASH/) {
                push @r, {&data_copy(%{$e})};
            }
            elsif (/SCALAR/) { 
                my $s = &data_copy($$e);
                push @r,\$s; 
            }
            else {
                push @r,$e;
            }
        }
    }
    return wantarray ? @r : $r[0];
}

package PrintTable::Text;
@ISA=('PrintTable');

$VERSION = 0.01;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = $class->SUPER::new(@_);
    bless ($self, $class);
    return $self->set_new(@_);
}

sub set_new {
    my $self = shift;
    $self->SUPER::set_new(@_);
    my %param = @_;

    if (ref($param{'-width'}) eq 'ARRAY') {
        $self->[0]{'width'} = $param{'-width'};
    }
    $self->[0]{'cellwrap' } = $param{'-cellwrap'} || 0;
    $self->[0]{'colpad'   } = defined $param{'-colpad'   } ? $param{'-colpad'   } : ' ';
    $self->[0]{'underline'} = defined $param{'-underline'} ? $param{'-underline'} : '-';
    $self->[0]{'indent'   } = defined $param{'-indent'   } ? $param{'-indent'   } : '';

    return $self;
}

sub row {
    my $self = shift;
    my ($self0, $fmt) = @{$self};
    $self->flush;
    my $f = $self0->{'outf'};
    my $cfmt = $fmt->{'cell'};

    unless($self0->{'width'}) {
        my $w = $self0->{'width'} = [];
        foreach my $c (@_) {
            push(@{$w}, length($c)+1);
        }
    }
    my $w = $self0->{'width'};
    my $colpad = $self0->{'colpad'};

    local $^W = 0;
    local $_;

    my $redo = 1;
    my ($l,$cl,$algn,$spc);
    my @arr = (@_);
    while ($redo) {
        $redo = 0;
        print $f $self0->{'indent'};
        foreach my $i (0 .. scalar @arr) {
            $l = length($arr[$i]);
            $cl = $w->[$i]; # col length

            $redo++ if $l > $cl;

            $algn = defined $cfmt->[$i]->{'align'} ? $cfmt->[$i]->{'align'} : $fmt->{'align'};
            $spc = $cl-$l;

            print $f
                $l == $cl ? $arr[$i]
                    : $l > $cl
                        ? substr($arr[$i],0,$cl,'')
                            : $algn eq 'right'
                                ? (' 'x($spc), $arr[$i])
                                    : $algn eq 'center' 
                                        ? (' 'x(int(($spc)/2)+(($spc)%2)),$arr[$i], ' 'x(int(($spc)/2)))
                                            : ($arr[$i], ' 'x($spc));
            $arr[$i] = '' unless $l > $cl;
            print $f $colpad;
        }
        $redo = 0 unless $self0->{'cellwrap'};
        print $f $self0->{'nl'};
    }
    return $self;
}

sub header_row {
    my $self = shift;
    my ($self0, $fmt) = @{$self};
    my $f = $self0->{'outf'};

    if ($_[0]) {
        $self0->{'header_row'} = [@_];
    }
    else {
        $self->flush;
        # use map so that values are copied.
        $self->row(map {$_} @{$self0->{'header_row'}});

        my $f = $self0->{'outf'};
        my $colpad = $self0->{'colpad'};
        my $ul = $self0->{'underline'};
        foreach my $w (@{$self0->{'width'}}) {
            print $f $ul x($w);
            print $f $colpad;
        }
        print $f $self0->{'nl'};
    }
    return $self;
}

sub close {
    my $self = shift;
    $self->SUPER::close(@_);
    my $f = $self->[0]{'outf'};
    return $self;
}

package main;
$VERSION = 0.2;

use File::Basename;

unless (-d 'CVS') {
        warn "You are not in a CVS checked out directory, you will get strange results!\n\n";
}

$FILE_PREPEND = $ENV{'CVSLS_FILE_PREPEND'};

$CONFIG{'look_tags'} = 0;
$CONFIG{'wor'} = 'repos'; #working or repos
$CONFIG{'delim'} = ' ';

my %WIDTH = (local => 8, working => 5, repos => 5); # defaults/minimums

&check_flags;

if ($ENV{'CVSLS_HEADER_EVERY'} =~ /^(\d+)$/) {
    $CONFIG{'header_every'} = $1 || 1;
}
elsif (`stty -a` =~ /; (\d+) rows;/) {
    $CONFIG{'header_every'} = $1 - ($CONFIG{'recurse'} ? 3 : 2);
}
else {
    $CONFIG{'header_every'} = 50;
}

sub check_flags {
    local $_;
    while ($ARGV[0] =~ /^-/) {
        $_ = shift(@ARGV);
        study;

        /^-{1,2}h(?:elp)?(?:(?:[:=])(.+))?$/i && do {
                &usage($1);
                exit;
        };
        s/^-d// && do {
                $CONFIG{'delim'} = $_;
                next;
        };
        /^-+hide-empty-dirs/ && do {
                $CONFIG{'hide_empty'}++;
                next;
        };
        s/^-PT[:=]?// && do {
                do {
                        warn qq(Only specify one "pretend tag"\n);
                        &usage;
                        exit;
                } if defined $CONFIG{'pretend_tag'};
                $CONFIG{'pretend_tag'} = $_;
                $CONFIG{'pretend_tag'} =~ /\w/ || die "must specify pretend tag.";
                next;
        };
        /^-HL$/ && do {
                $CONFIG{'hide_local'} = 1;
                next;
        };
        /^-[Rr]$/ && do {
                $CONFIG{'recurse'} = 1;
                next;
        };
        s/^-WT(Q)?[:=]// && do {
                $CONFIG{'quit_after_find'} ||= $1 ? 1 : 0;
                my $wild = $_;
                local $_;
                for (split(/,/,$wild)) {
                        s/\*/.*/g;
                            s/\?/\./g;
                            $_ = "\^\Q$_" . '$'; #'
                            s/\\\.\\\*/\.\*/g;
                            s/\\\./\./g;
                            $CONFIG{'wildcard_tags'}->{$_} = 1;
                }
                $CONFIG{'all_tags'} ||= {};
                next;
        };
        s/^--?(Q)?rxtag(Q)?[:=]?// && do {
                $CONFIG{'quit_after_find'} ||= ($1||$2) ? 1 : 0;
                my $regx = $_;
                local $_;
                for (split(/,/,$regx)) {
                        $CONFIG{'wildcard_tags'}->{$_} = 1;
                }
                $CONFIG{'all_tags'} ||= {};
                next;
        };
        /^--?files$|^--$/ && last;
        s/^-T(Q)?(:|=)?// && do {
                $CONFIG{'my_tag_order'} = 1 if $2 eq '=';
                $CONFIG{'quit_after_find'} ||= $1 ? 1 : 0;
                if ($_) {
                        @LOOK_TAGS = split /,/;
                        %LOOK_TAGS = map { $_ => 1 } @LOOK_TAGS;
                        $CONFIG{'look_tags'} = scalar @LOOK_TAGS;
                }
                else {
                        $CONFIG{'all_tags'}  ||= {};
                        $CONFIG{'find_tags'}   = 1;
                }
                next;
        };
        /^--?working$/ && do {
                $CONFIG{'wor'} = 'working';
                next;
        };
        /^--?cmpall$/  && do {
                $CONFIG{'cmpall'} = 1;
                next;
        };
        s/^--?last-author(:|=)?// && do {
                $CONFIG{'show_author'} = 1;
                if ($_) {
                        $CONFIG{'author_eq'} ||= {};
                        foreach my $author (split(/,\s*/)) {
                                $CONFIG{'author_eq'}->{$author}++;
                        }
                }
                next;
        };
        /--?sticky[-_]options?[:=]?/ && do {
                $CONFIG{'show_sticky_opts'} = 1;
                next;
        };
        s/^--?kosher[:=]?// && do {
                /.+/ || die "when you use -kosher=tag, specify a tag.\n";
                $CONFIG{'kosher'} = $_;
                next;
        };
        /-+.+/ && do {
                die "unknown option: $_\n";
        }
    }
}

if ($CONFIG{'kosher'} && ! $CONFIG{'find_tags'}) {
        unless ($LOOK_TAGS{$CONFIG{'kosher'}}) {
                unshift(@LOOK_TAGS, $CONFIG{'kosher'});
                $LOOK_TAGS{$CONFIG{'kosher'}} = 1;
                $CONFIG{'look_tags'}++;
        }
}

my $st;
my $log_info;
{
    my $command;
    my $log_command;
    {
        #local $|=1;
        #print "Querying CVS server . . .";
        local @ARGV = @ARGV;
        @ARGV = map {s/^-/\\\\-/; s~/$~~; $_} @ARGV;
        my $recurse = $CONFIG{'recurse'} ? '' : 'l';
        $command     = scalar @ARGV ? "cvs status -v$recurse ${\(join' ',map{quotemeta}@ARGV)} 2>&1"
                                    : "cvs status -v$recurse 2>&1";
        if ($CONFIG{'show_author'}) {
            if ($CONFIG{'author_eq'}) {
                my $auth = $CONFIG{'author_eq'} && join ',', keys %{ @CONFIG{'author_eq'} };
                $log_command = scalar @ARGV ? "cvs log -w$auth -N$recurse ${\(join' ',map{quotemeta}@ARGV)} 2>&1"
                                            : "cvs log -w$auth -N$recurse 2>&1";
            }
            else {
                $log_command = scalar @ARGV ? "cvs log -N$recurse ${\(join' ',map{quotemeta}@ARGV)} 2>&1"
                                            : "cvs log -N$recurse 2>&1";
            }
        }
        #@cvs_status = scalar @ARGV ? `cvs status -vl ${\(join' ',map{quotemeta}@ARGV)} 2>/dev/null`
        #                           : `cvs status -vl 2>/dev/null`;
        #print "\r                          \r";
        #select(undef,undef,undef,.15);
    }
    {
        my ($dir, $name, $tags, $tg, $bor, $rv, $branch_rev);
        $dir = '.';

        local $/ = "===================================================================\n";
        if ($CONFIG{'show_author'}) {
            my %h;
            for (`$log_command`) {
                /^RCS file: (.+)$/mg;
                my $file = $1;
                while (/^revision (\d+(?:\.\d+)+)\b/mg) {
                    my $r = $1;
                    /author: (.+?);/mg;
                    ($h{$file}{'author'}{$r}) = $1
                }
            }
            $log_info = \%h;
        }
        for (`$command`) {
                die "CVS error: $_\n" if /cvs.+abort/;
                /File: (?:no file )?(.+?)\s+Status: (?:\S+(?:\s\S+)?)/;
                if ($1) {
                    $name = $1;
                }
                else {
                    $dir = do {
                        my   @nd =           /: Examining (\S+)/g;
                        $nd[-1] ne '' ? $nd[-1] : $dir;
                    };
                    next;
                }
                my $h = $st->{$dir}->{$name} = {};
              ( $h->{'status' }              )  = /Status: (\S+(?:\s\S+)?)/;
              ( $h->{'working'}              )  = /Working revision:\s+(\d\S*)/;
              ( $h->{'repos'  }, $h->{'file'})  = /Repository revision:\s+(\d\S*)\s+(.+)/;
              ( $h->{'sticky' }, $branch_rev )  = /Sticky Tag:\s+(\S+) (\(.+?\))/;
                if ($CONFIG{'show_sticky_opts'}) {
              ( $h->{'stick_opts'}              )  = /Sticky Options:\s+\((.+)\)/;
                $ALL_STICKY_OPTS{$h->{'stick_opts'}}++;
                }

                {
                    my $w = length($h->{'status'});
                    $WIDTH{'status' } = $w if $w > $WIDTH{'status'};
                       $w = length($h->{'working'});
                    $WIDTH{'working'} = $w if $w > $WIDTH{'working'};
                       $w = length($h->{'repos'});
                    $WIDTH{'repos'  } = $w if $w > $WIDTH{'repos'};
                }

                if ($CONFIG{'show_author'} && $h->{'repos'}) {
                    my $author = $log_info->{ $h->{'file'} }{'author'}{ $h->{'repos'} };
                    $CONFIG{'all_authors'}->{$author}++;
                    $h->{'author'} = $author;
                }

                delete $st->{$dir}->{$name} && next unless $h->{'repos'};

                $h->{'bor'} = $branch_rev =~ /revision/ ? 'r' :
                              $branch_rev =~ /branch/   ? 'b' : '';

              ( $h->{'stickyrev'} ) = $branch_rev =~ /: (.+?)\)/;

              ( $tags ) = /Existing Tags:(.+)\n\n/s;
                $tags   = '' if $tags =~ /No Tags Exist/;

                if ($CONFIG{'pretend_tag'} && $tags) {
                      ( $h->{'sticky'}, $h->{'bor'}, $h->{'stickyrev'} ) = 
                                $tags =~ /\s+($CONFIG{'pretend_tag'})\s+\((\w)(?:\w+): (.+?)\)/o;
                        $h->{'repos'} = $h->{'stickyrev'};
                        #next unless $h->{'sticky'}; #we're pretending to be a tag and this file
                                                    #wouldn't exist in this directory.
                }

                foreach my $line (split(/\n/,$tags)) {
                      ( $tg, $bor, $rv ) = $line =~ /^\s+(\S+)\s+\((\w)(?:\w+): (.+?)\)/;

                        next unless $CONFIG{'all_tags'} || defined $LOOK_TAGS{$tg};
                        $CONFIG{'all_tags'}->{$tg}++ if $CONFIG{'all_tags'};

                        $h->{'tags'}->{$tg} = 
                                $h->{'bor'} ?
                                    $bor eq $h->{'bor'} ?
                                        $h->{'sticky'} ?
                                            $tg eq $h->{'sticky'} ? 'T'
                                                :
                                                (map { $_ == 0 ? '=' : $_ > 0 ? 'N' : 'O' }
                                                tag_cmp($rv, $h->{'stickyrev'}))[0]
                                            :
                                            $CONFIG{'cmpall'} ?
                                                (map { $_ == 0 ? '~' : $_ > 0 ? '^' : 'v' }
                                                tag_cmp($rv,$h->{$CONFIG{'wor'}}))[0]
                                                : 
                                                $bor
                                        :
                                        $CONFIG{'cmpall'} ?
                                            (map { $_ == 0 ? '~' : $_ > 0 ? '^' : 'v' }
                                            tag_cmp($rv,$h->{$CONFIG{'wor'}}))[0]
                                            :
                                            $bor
                                    :
                                    $bor eq 'b' ?
                                        $CONFIG{'cmpall'} ?
                                            (map { $_ == 0 ? '~' : $_ > 0 ? '^' : 'v' }
                                            tag_cmp($rv,$h->{$CONFIG{'wor'}}))[0]
                                            :
                                            'b'
                                        :
                                        (map { $_ == 0 ? '-' : $_ > 0 ? 'n' : 'o' }
                                        tag_cmp($rv, $h->{$CONFIG{'wor'}}))[0]
                }
                $dir = do {
                        my   @nd =           /: Examining (\S+)/g;
                        $nd[-1] ne '' ? $nd[-1] : $dir;
                        };
                die "CVS error: $_\n" if /cvs.+abort/;
        }
    }
}

if ($CONFIG{'kosher'}) {
        unless (defined($CONFIG{'all_tags'}->{$CONFIG{'kosher'}}) || defined($LOOK_TAGS{$CONFIG{'kosher'}})) {
                local $| = 1;
                print "I didn't find the tag: $CONFIG{'kosher'}, should I continue? [n] (y/n) > ";
                my $ans = <STDIN>;
                exit unless $ans =~ /^y(e|es)?$/;
                delete $CONFIG{'kosher'};
        }
}

if ($CONFIG{'find_tags'}) {
    @LOOK_TAGS = sort tag_cmp grep {!/^$/} keys %{$CONFIG{'all_tags'}};
    %LOOK_TAGS = map { $_ => 1 } @LOOK_TAGS;
    $CONFIG{'look_tags'} = scalar @LOOK_TAGS;
}
elsif ($CONFIG{'wildcard_tags'}) {
    # both find_tags and wildcard_tags is useless
    # because find_tags will find all.
    my $temp;
    my @nlook_tags = grep {!/^$/} map {
        $temp = $_;
        (scalar grep { $temp =~ /$_/ } keys %{$CONFIG{'wildcard_tags'}})
            ? $temp : ''
            } keys %{$CONFIG{'all_tags'}};

    @LOOK_TAGS = $CONFIG{'my_tag_order'} ?
        ((sort tag_cmp @nlook_tags),@LOOK_TAGS)
            : (sort tag_cmp (@nlook_tags,@LOOK_TAGS));
    %LOOK_TAGS = map { $_ => 1 } @LOOK_TAGS;
    $CONFIG{'look_tags'} = scalar @LOOK_TAGS;
}

my %ask_files;
my $ask_files;
my %ask_all_files_dirs;
{
    my ($dir, $f);
    foreach my $file (@ARGV) {
        $ask_files++;
        if (-d $file) {
            $file =~ s~/$~~;
            $ask_all_files_dirs{$file}++;
            next;
        }
        ($f, $dir) = fileparse($file);
        $dir =~ s~^\./$~\.~;
        $dir =~ s~/$~~;
        if ($f eq '') {
            push(@other_ask_dirs, $dir);
        }
        else {
            $ask_files{$dir}->{$f}++;
        }
    }
}

my %files;
{
    if ($CONFIG{'recurse'}) {
        if ($ask_files) {
            foreach my $dir (keys %ask_files, keys %ask_all_files_dirs) {
                opendir(DIR,$dir) || next; #die "can't open dir: $dir, $!";
                my %n_files = map { $_ => 1 } readdir(DIR), keys %{$st->{$dir}}, keys %{$ask_files{$dir}};
                @{$files{$dir}} = sort tag_cmp keys %n_files;
                closedir(DIR);
            }
        }
        else {
            my @chk_dir = ('.');
            my $dir;
            while ($dir = shift(@chk_dir)) {
                opendir(DIR,$dir) || die "can't open dir: $dir, $!";
                my %n_files = map { $_ => 1 } grep { !/(^\.\.?$)|(^CVS$)/ } readdir(DIR), keys %{$st->{$dir}};
                foreach my $file (keys %n_files) {
                    if (-d "$dir/$file") {
                        $dir eq '.' ? unshift(@chk_dir,$file) : unshift(@chk_dir,join('/',$dir,$file));
                        $n_files{$file} = 0;
                    }
                    @{$files{$dir}} = sort tag_cmp grep { $n_files{$_} } keys %n_files;
                }
                closedir(DIR);
            }
        }
    }
    else {
        opendir(DIR,'.') || die "can't open dir: $!";
        my %n_files = map { $_ => 1 } readdir(DIR), keys %{$st->{'.'}}, @ARGV;
        @{$files{'.'}} = sort tag_cmp keys %n_files;
        closedir(DIR);
    }
}

unless ($CONFIG{'file_width'}) { #find longest name
    my $l=1;
    my $tl;
    foreach my $name (map { @{$_} } values %files) {
        $tl = length($name);
        if ($tl > $l) {
            $l = $tl;
        }
    }
    $CONFIG{'file_width'} = $l;
}
if ($CONFIG{'show_author'}) {
    my $l=1;
    my $tl;
    foreach my $name (keys %{$CONFIG{'all_authors'}}) {
            $tl = length($name);
            $l = $tl if $tl > $l;
    }
    $CONFIG{'show_author'} = $l;
    push(@OTHER_COLS, 'author');
    push(@OTHER_COL_HEADS, 'Author');
    push(@OTHER_COL_WIDTHS, $l);
}
if ($CONFIG{'show_sticky_opts'}) {
        my $l=1;
        my $tl;
        foreach my $name (keys %ALL_STICKY_OPTS) {
                $tl = length($name);
                $l = $tl if $tl > $l;
        }
        $l = 4 if 4 > $l;
        push(@OTHER_COLS, 'stick_opts');
        push(@OTHER_COL_HEADS, 'Opts');
        push(@OTHER_COL_WIDTHS, $l);
}

my $t = new PrintTable(-use => 'Text', -cols => 4 + $CONFIG{'look_tags'},
                       -width => [
                                   map { $_+1 } @WIDTH{qw/status working repos/},
                                   @OTHER_COL_WIDTHS, @LOOK_TAGS{@LOOK_TAGS}, $CONFIG{'file_width'}
                                 ],
                        -colpad => $CONFIG{'delim'},
                          );


{
    my $i = 1;
    my $x = 1;
    my $temp_table = $CONFIG{'look_tags'} ?
        new PrintTable(-use => 'Text', -cols => 3, -width => [qw/30 30 30/],)
            : undef;
    $t->header_row('Status','Local','Repository',
                   (@OTHER_COL_HEADS),
                   (map { $temp_table->cell("$i: $_"); $x = substr($i,-1); $i++; $x } @LOOK_TAGS), 'File Name');
    $temp_table->close if $temp_table;
    if ($CONFIG{'quit_after_find'}) {
        $t->close;
        exit;
    }
    $t->header_row unless $CONFIG{'header_every'};
}

my $kosher = $CONFIG{'kosher'} if defined $CONFIG{'kosher'};
{
    my $line         = 0;
    my $header_line  = 1;
    my $last_was_dir = 0;
    my $hide_empty   = $CONFIG{'hide_empty'};
    foreach my $dir (sort tag_cmp keys %files) {
        my $printed_dir=0;
        if ($CONFIG{'recurse'}) {
            $t->flush;
            print "\n" unless $last_was_dir++;
            print "Directory: $dir\n" unless $hide_empty;
        }
        for (@{$files{$dir}}) {
            next if -d "$dir/$_";

            $t->header_row if $CONFIG{'header_every'} && $header_line-- == 1;

            $ask_files && next unless $ask_files{$dir}->{$_} || $ask_all_files_dirs{$dir};
            if (my $h = defined $st->{$dir}->{$_} && $st->{$dir}->{$_}) {
                next if ($kosher && defined $h->{'tags'}->{$kosher} && $h->{'tags'}->{$kosher} =~ /[-=~T]/);
                next if ($CONFIG{'author_eq'} && ! $CONFIG{'author_eq'}->{$h->{'author'}});

                print "Directory: $dir\n" if ($hide_empty && ! $printed_dir++);
                $t->row($h->{'status'},
                        -f "$dir/$_" ? ($h->{'working'} eq $h->{'repos'}) ? ' ->' : $h->{'working'} : '<-',
                        $h->{'repos'},
                        (map { $h->{$_} } @OTHER_COLS),
                        (map { $h->{'tags'}->{$_} || '' } @LOOK_TAGS),
                        $_);
                    $header_line = 1 unless ++$line % $CONFIG{'header_every'};
                $last_was_dir=0;
            }
            elsif (! $CONFIG{'hide_local'}) {
                print "Directory: $dir\n" if ($hide_empty && ! $printed_dir++);
                $t->row('','','', (map { '' } @OTHER_COLS, @LOOK_TAGS), $_);
                    $header_line = 1 unless ++$line % $CONFIG{'header_every'};
                $last_was_dir=0;
            }
        }
    }
}

$t->close;

sub tag_cmp {
    if ($_[1]) {
        $a = shift;
        $b = shift;
    }
    return 0 unless $a cmp $b;
    my @a = split(/(\D)/,$a);
    my @b = split(/(\D)/,$b);
    my $x = $#a > $#b ? $#b : $#a;
    my $cmp;
    foreach my $i (0 .. $x) {
        $cmp = $a[$i] =~ /^\d+$/ && $b[$i] =~ /^\d+$/ ? $a[$i] <=> $b[$i] : $a[$i] cmp $b[$i];
        return $cmp if $cmp;
    }
    return $#a <=> $#b;
}

sub usage {
        my $what = shift;

        my %help = (
                version => "This is cvsls version $VERSION with embedded modules.
Please watch for future releases\n",
                kosher => "
The 'kosher' option was inpired by cvs_kosher.pl by Pradeep Chetal.

You have to check out your files as HEAD

('cvs co -r sometag' i.e. Checking out as a tag, or using
-PT will be unproductive. The tag that you are comparing with kosher
should be the latest tag, the use is to make sure the development
HEAD versions are all tagged with latest tag.)

Then to look for files that are out of sync with the tag in which you
are interested, do one of the following:

1) csvls -WT:sometag-* -r -kosher:sometag-1-9-0 -HL |less

Explanations:
        1) -WT:sometag-*
                look for all tags that match that

           -r
                recurse subdirectories

           -kosher:sometag-1-9-0
                show which files are different in HEAD than 'sometag-1-9-0'

If you thought about it long enough, you may be able to produce good results
using -PT and -working.

",
                );

        my $help = join(', ', keys %help);

        if ($what) {
            if (defined $help{$what}) {
                print $help{$what};
            }
            else {
                print "I cannot offer help on '$what', I only have specific help for:\n";
                print "\t",join(', ',keys %help), "\n\n";
            }
        }
        else {
            print <<"END";
Usage: $0 [OPTIONS...] [-files] [files...]
        OPTIONS: [-PT:] [-HL] [-WT | -WTQ ] [-T | -TQ ]

        cvsls: "The developers paradise"

        --h --help -help -he --hel -hel etc. this message.
        -h:xxx etc...
        -help:xxx    Get specific help on any of these commands:
                     $help

        -d' '        Delimiter (like "cut -d' '" except in the opposite direction)

        -hide-empty-dirs

        -R -r        Be recursive (look at sub directories)

        -PT             Pretend to be some tag (only one allowed)

                     $0 -PT:sometag

        -HL             Hide files that are only found locally.

        -WT             Look for wildcard tags:

                     $0 -WT:sometag*,tag??end

        -rxtag       Look for tags based on Perl regular expressions:
                        (NOTE: -WT automatically creates
                        this assertion: /^wilcard\$/
                        -rxtag does not.)

                     $0 -rxtag:xxxxx    (i.e. some regular expression,
                        perldoc perlre)

        -T             Look for tags:
                        $0 -T:sometag,othertag file1 file2
                        $0 -T=sometag,othertag file1 file2
                          ('=' causes order specified to be retained
                          tags will be appended to the end sorted list
                          of tags found by -WT if any)

                     Look for ALL tags:
                        $0 -T

        Q             may be specified after
                        -WT (-WTQ)
                        -rxtag (-Qrxtag, -rxtagQ)
                        -T (-TQ)

                     to print the tags that were found, but not the files.

        -working     Compare to the working (local) version of the file.
                     (Default action is to compare the MAIN version of the file.)

        --           Forces everything after to be interpereted as file names.
        -files       Forces everything after to be interpereted as file names.

        -cmpall
        |             (use carefully) Forces file version
        |                comparison between 'revision' and 'branch' tags.
        |
        |    The indicators, (see LEGEND) in lieu of 'b' and 'r' are:
        |                '~' for same,
        |                '^' for newer,
        |                'v' for older.
        |
        |   (One tip: [ - - ^ - ] will be misleading when '^' marks
        |   a branch file that was never modified.  This file version appears
        |   newer, which may or may not be the case, depending on if the
        |   file was modified and whether the branch was merged. A properly
        |   commited modified branch file should look like [ o o ~ - ] )
        L________________________________________

        -kosher:sometag
                        Print only files that aren't exactly tagged
                        for this tag.  Works great with -HL.

        -sticky-options
                        Show the 'Sticky Options' associated with the file.

        ___alpha features___
        |
        |   These two features are implemented badly.  You need to set CVSLS_FILE_PREPEND
        |   for them to work.  I will remove or change them in the future (they were hacked
        |   in for one person, and it wasn't done correctly).
        |
        |   -last-author        Print the name of the last person to
        |                       check in each file (SLOW)
        |
        |   -last-author=name1,name2
        |                       Only show files that were last checked-in
        |                       by person(s). (SLOW)
        L________________________________________


        TAG LEGEND:

             Compared to current tag:
                T   This version of the file is TAGGED with this tag.
                =   This version is the same in this other tag.
                N   A newer version of this file exists with this other tag.
                O   An older version of this file exists with this other tag.

             Generally:
                -  The MAIN version of this file is the same as this tag has.
                n  This file is newer in this tag than the MAIN version.
                o  This file is older in this tag than the MAIN version.

                r  This is a revision TAG file, which cvsls can't
                        compare to your branch.
                b  This is a branch TAG file, which cvsls can't
                        compare to your revision.

        SUGGESTIONS:
                cvsls -WT:foo-1_5_* -T=V1_0,preV2_0
                cvsls -PT:foo-1_5_12 -WT:foo-R1_5_* -T=V1_0,preV2_0

                cvsls -WT:foo-*

                cvsls -rxtag:1_5_[0-3]
                        Shows all tags marked with  branch convention.

        ENVIRONMENT VARIABLES:
                CVSLS_HEADER_EVERY = x
                        Print the header every 'x' number of lines.
                CVSLS_FILE_PREPEND
                        Supports looking in the files to find authors.
                        This is _alpha_, and will be removed in the future.

        AUTHOR
                "Brandon L. Golm" <br\@ndon.com>
END
        }
}
__END__

=head1 NAME

cvsls - displays 'cvs status' in an configurable and easy to digest format.

=head1 SYNOPSIS

C<cvsls -h> for help.  POD is here to point you there.

=head1 AUTHOR

"Brandon L. Golm" <br@ndon.com>

Please feel free to contact me with questions or problems.

=head1 SCRIPT CATEGORIES

VersionControl/CVS

=head1 SEE ALSO

cvs, mks2cvs

=head1 README

Displays 'cvs status' in an configurable and easy to digest format.
See the 'cvsls -h' option for more help.

This program is I<versioned below 1.0> because I want to clean up
the documentation.  Otherwise, there's nothing wrong with this code,
and you shouldn't be scared of it.

Please note that '-kosher' option is very usefull; but you should
read C<cvsls -help:kosher> to see how to get started and what
it might offer you.

I accept feature requests and patches as long as the new code
follows the same style as this code or C<perlstyle>.

Color support is one idea I already want to work on.

=head1 COPYRIGHT

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself provided this message and author
information are retained. (BUT PLEASE LET ME KNOW IF YOU DO!)

=cut