package VCP::Filter::addlabels; =head1 NAME VCP::Filter::addlabels - Add labels to each revision =head1 SYNOPSIS ## From the command line: vcp addlabels: "rev_$rev_id" "change_$change_id" -- ## In a .vcp file: AddLabels: rev_$rev_id change_$change_id # ... etc ... =head1 DESCRIPTION Used when you want to track the original rev_id, change_id, branch_id, etc. of each revision had in the source repository by adding a label. Can be used to turn any piece of metadata in to a label. There is no way to add labels only to selected revisions at this time, but if you try to add a label for metadata that is undefined or empty, it will not be added. =for test_script t/61addlabels.t =cut $VERSION = 1 ; use strict ; use VCP::Debug qw( :debug ); use VCP::Filter; use base qw( VCP::Filter ); use fields ( 'MAP_SUB', ## The rules to apply, compiled in to an anon sub ); sub _empty { ! ( defined $_ && length $_ ) } sub _compile_label_add_routine { my VCP::Filter::addlabels $self = shift; my $preamble = <as_string, ")" );\n\n} if explicitly_debugging $self; my @code = ( $preamble ); for ( @_ ) { my $l = $_; my %f; $l =~ s/\$(\w+)/$f{$1}=undef; "' . \$rev->$1 . '"/ge; $l =~ s/\$\{[^}]+\}/$f{$1}=undef; "' . \$rev->$1 . '"/ge; push @code, join "", "\$rev->add_label( '", $l, "' )", keys %f ? ( " if ! grep _empty, ", join( ", ", map "\$rev->$_()", sort keys %f ) ) : (), ";\n"; } push @code, "\$self->dest->handle_rev( \$rev );\n"; my $code = join "", @code; $code =~ s/^/ /mg; # NOTE: the sub is a closure and encloses our $self $code = "sub {\n$code}"; debug "vcp: addlabels code:\n$code" if explicitly_debugging $self; return( eval $code or die "vcp: $@ compiling\n", do { my $w = length( $code =~ tr/\n// + 1 ) ; my $ln; 1 while chomp $code; $code =~ s{^}[sprintf "%${w}d|",++$ln]gme; "$code\n"; }, ); } sub new { my $class = shift ; $class = ref $class || $class ; my $self = $class->SUPER::new( @_ ) ; ## Parse the options my ( $spec, $options ) = @_ ; # Add the default rule. my @label_specs; while ( @$options ) { my $v = shift @$options; last if $v eq "--"; push @label_specs, $v; } if ( debugging $self ) { require Data::Dumper; debug( "vcp: ", Data::Dumper->Dump( [ \@label_specs], [ "addlabels" ] ) ); } $self->{MAP_SUB} = $self->_compile_label_add_routine( @label_specs ); return $self ; } sub handle_rev { my VCP::Filter::addlabels $self = shift; $self->{MAP_SUB}->( @_ ); } =head1 LIMITATIONS There is no way (yet) of telling the mapper to continue processing the rules list. We could implement labels like C< <>> > to be allowed before pattern expressions (but not between pattern and result), and we could then impelement C< <>> >. And a C< <> > could be used to fall through to the next label. All of which is wonderful, but I want to gain some real world experience with the current system and find a use case for gotos and fallthroughs before I implement them. This comment is here to solicit feedback :). =head1 AUTHOR Barrie Slaymaker =head1 COPYRIGHT Copyright (c) 2000, 2001, 2002 Perforce Software, Inc. All rights reserved. See L (C) for the terms of use. =cut 1