#!/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.8';

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

if ($ENV{'CVSLS_HEADER_EVERY'} =~ /^(\d+)$/) {
	$CONFIG{'header_every'} = $1 || 1;
}
else {
	$CONFIG{'header_every'} = 50;
}
$FILE_PREPEND = $ENV{'CVSLS_FILE_PREPEND'};

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

&check_flags;

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 $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";
	#@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";
	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'}}++;
		}

		if ($CONFIG{'show_author'}) {
			my $author = &find_author($h->{'file'});
			$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 => [ qw/15 11 11/, @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 find_author {
	my $file = shift;
	my $author;
	unless (-f "$FILE_PREPEND$file") {
		die qq(I can't find "$FILE_PREPEND$file"
you may need to set CVSLS_FILE_PREPEND for the location of the repository.
);
	}
	open(FILE, "$FILE_PREPEND$file") || die "couldn't open file $FILE_PREPEND$file because: $!\n";
	local $/ = "\n";
	local $_;
	while (<FILE>) {
		next unless /date/;
		($author) = /author ([^;]+?);/;
		last;
	}
	close FILE;
	return $author;
}

sub usage {
	my $what = shift;

	my %help = (
		version => "This is cvsls version $VERSION with embedded modules.
Please watch for future releases\n",
		kosher => "
The goal of the 'kosher' option is to emulate 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 into 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 it up.
I plan to make 'author'
features use cvs output instead of looking for files (this feature
was added as a total hack).  Also, I plan to make the widths of
version number columns change if needed.  Also, I plan to mkae
the documentation better. 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.

=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