view release on metacpan or  search on metacpan

examples/CCreport  view on Meta::CPAN

    push(@sel, '-name', qq("$opt{name}")) if $opt{name};
    if ($opt{type}) {
	push(@sel, '-type', $opt{type}->[0]);
    } else {
	push(@sel, qw(-type fd));
    }
    push(@sel, '-cview') if $opt{cview};
    if ($branches[0] eq '(ALL)') {
	$find = "find @sel -ver '$Pred' -print";
    } else {
	$find = "find @sel -ver '(brtype($branches[0])";
	for (@branches[1..$#branches]) { $find .= " || brtype($_)" }
	$find .= ") && $Pred' -print";
    }

    # Now, for each changed elem we run two 'cleartool describe' cmds:
    # one to get the data on the elem itself and another for the comment.
    for my $version (sort grep m%$dir%, $ct->argv($find)->qx) {

	# Ignore zero-branches and checked-out elements.
	$version =~ m+/CHECKEDOUT$|/0$+ && next;

	# Skip anything in a 'private' subdirectory.
	$version =~ m+/private/|/trigtest/+ && next;

	# Get the raw data about this version and clean it up a bit.
	my($line) = $ct->desc([qw(-fmt %d===%u===%Fu===%a===%l===%En@@%Sn)],
			                                      $version)->qx;
	next if $?;
	my($date, $username, $fullname, $attrs, $labels, $xpn) =
	                                                 split /===/, $line;

	# Separate the version-extended pathname into path and version.
	my($pn, $vers) = ($xpn =~ m%(.*)@@(.*)%);

	# Due to a bug in ClearCase/NT, changes made on NT sometimes
	# come over as being by 'username', not by 'fullname' (ie the
	# 1st passwd field instead of the 5th, because CC doesn't map
	# it at checkin time). So we work around that here.
	if (my $tmp = (getpwnam(lc($fullname)))[5]) {
	    $fullname = $tmp;
	}

	# Normalize the fullname since we'll be using it as part of a key.
	$fullname =~ s/,.*//;
	$fullname =~ s/[\s.]+/ /g;

	# Make an entry for this user indicating that we've seen him/her.
	$Changers{lc($fullname)} = $fullname;

	# Simplify the pathname to remove version-extended subdirs
	# for readability: '$cpn' is 'cleaned pathname'.
	(my $cpn = $pn) =~ s%@@.*?/\d+/%/%g; 
	#$cpn =~ s%(@@)?/main/.*?(CHECKEDOUT\.)?\d+/%/%g;

	# Get the comment and format it correctly.
	my $cmt = $ct->desc([qw(-fmt %c)], $version)->qx;
	next if $?;

	# "Paragraph mode" - causes chomp to remove multiple trailing \n
	{ local $/ = ''; chomp $cmt; }

	# If the comment contains a line ending with ~p we
	# consider it to be intentionally private.
	# Useful when testing triggers etc.
	next if $cmt =~ /~p$/mi;

	# Ignore attributes users aren't interested in.
	{ local $^W=0; $attrs =~ s/(,\s)?_\w+=".+?"(,\s)?/$2/g; }

	# Now we use the {who,attrs,comment} as the key in a
	# a hash pointing to the names of changed files.
	# Show the date for each change, unless it's guaranteed
	# to be yesterday.

	# Strip years and seconds from date; nobody cares about that.
	$date =~ s/^(\d+-\w+)-\d+\.(\d+:\d+):\d+/$1.$2/;

	# Build up the line to print for this modified file.
	# Labels go at the end because there might not be any.
	my $ln;
	if ($opt{plain}) {
	    $ln = sprintf("%-60s  - %-16s  %-14s  %s",
	    $cpn, $vers, $date, $labels);
	} else {
	    my($base,$path,$ext) = fileparse($cpn, '\..*?');
	    if ($opt{fhref}) {
		my $flnk;
		if (-f "/view/$vtag$pn@@/main/0") {
		    $flnk = qq($path<a href="$opt{fhref}?file=/view/$vtag$pn\@\@$vers" target="_blank"><b>$base</b></a><a href="$opt{fhref}?render=yes&file=/view/$vtag$pn\@\@$vers" target="_blank"><b>$ext</b></a>);
		} else {
		    $flnk = font({color=>"green"}, $cpn);
		}
		my $dlnk = qq(<a href="$opt{fhref}?diff=/view/$vtag$pn\@\@$vers" target="_blank">$vers</a>);
		$ln = sprintf("%-60s  - %-16s  %-14s  %s",
					    $flnk, $dlnk, $date, $labels);
	    } else {
		$ln = sprintf("%-60s  - %-16s  %-14s  %s",
			    $path . b($base . $ext), $vers, $date, $labels);
	    }
	}

	# Strip any trailing spaces
	$ln =~ s/\s+$//;

	# Now push the modified line onto its comment's bucket.
	push(@{$Files{$username,$fullname,$attrs,$cmt}}, $ln);
    }
}

# At this point we have a database (in %Files) of all changes found.
# Format and print this data, in HTML or plain text, to stdout or to mail,
# as requested.
{
    # We collect all the output and put it in an array, then print or
    # mail it later.  Done this way so we can add "wanderers" to the
    # mailing list.
    my(@Plain, @Html) = ();

    my $indent = ' 'x3;			# the amount to indent output by