package VCP::Filter::labelmap; =head1 NAME VCP::Filter::labelmap - Alter or remove labels from each revision =head1 SYNOPSIS ## From the command line: vcp <source> labelmap: "rev_$rev_id" "change_$change_id" -- <dest> ## In a .vcp file: LabelMap: foo-... <<delete>> # remove all labels beginning with foo- F...R <<delete>> # remove all labels F v-(...) V-$1 # use uppercase v prefixes =head1 DESCRIPTION Allows labels to be altered or removed using a syntax similar to VCP::Filter::map. This is being written for development use so more documentation is needed. See L<VCP::Filter::map|VCP::Filter::map> for more examples of pattern matching (though VCP::Filter::labelmap does not use <branch_id> syntax). =for test_script t/61labelmap.t =cut $VERSION = 1 ; use strict ; use VCP::Debug qw( :debug ); use VCP::Utils qw( shell_quote ); use VCP::Filter; use Regexp::Shellish qw( compile_shellish ); use base qw( VCP::Filter ); use fields ( 'MAP_SUB', ## The rules to apply, compiled in to an anon sub ); ## NOTE: this code is simpler than, but similar to, the same-named ## helper routines in VCP::Filter::map. That module uses multifield ## patterns and actions, this one uses single field (ie just the ## label) patterns and actions. sub _parse_expr { my ( $type, $v ) = @_; my %expr; return () unless defined $v; if ( $type eq "result" ) { return ( delete => 1, %expr ) if $v eq "<<delete>>"; return ( keep => 1, %expr ) if $v eq "<<keep>>"; } $expr{label} = $v; die "vcp: unable to parse labelmap $type '$v'\n" unless defined $expr{label}; for ( "label" ) { ## loop is just to mimic code in VCP::Filter::map die "newline in '$expr{$_}' of labelmap $type '$v'\n" if $expr{$_} =~ tr/\n//; die "unescaped '$1' in '$expr{$_}' of labelmap $type '$v'\n" if $expr{$_} =~ ( $type eq "pattern" ? qr{(?<!\\)(?:\\\\)*([\@#<>\[\]{}\$])} : qr{(?<!\\)(?:\\\\)*([\@#<>\[\]*?()]|\.\.\.)|(?<!\$)\{} ); ## We reserve a lot of metacharacters so we can do more later. die "illegal escape sequence '$1' in '$expr{$_}' of labelmap $type '$v'\n" if $expr{$_} =~ qr{(?<!\\)(?:\\\\)*(\\(?!=\.\.\.)[^\@#<>\[\]{}*?()])}; } return %expr; } sub _compile_rule { my VCP::Filter::labelmap $self = shift; my ( $name, $pattern, $result ) = @_; my %pattern_expr = _parse_expr pattern => $pattern; my %result_expr = _parse_expr result => $result; ## The test expression is a single regexp that matches a string ## built up from some pieces of the rev metadata. Right now, only ## the name and the branch_id are tested, by someday the labels, ## change_id, rev_id, and comment could be tested. If so, the ## comment field would need to come last due to newline issues. my $test_expr = ! keys %pattern_expr ? 1 ## This happens iff the pattern was undef (which ## should only happen for the default rule). : join( "", "m'", ## Note the single-quotish context do { my $re = compile_shellish( $pattern_expr{label} ); $re =~ s{(')}{\\`}g; $re =~ s{\A\(\?[\w-]*: (.*) \)}{$1}gx; # for readability # of dumped code $re; }, "'", ); my $debugging = explicitly_debugging $self; $pattern = defined $pattern ? qq{"$pattern"} : "match all"; my $result_statement = join( "", $debugging ? qq{VCP::Debug::debug( 'vcp: matched $name ($pattern)' );\n} : (), $result_expr{keep} ? ( $debugging ? qq{VCP::Debug::debug( "vcp: <<keep>>ing" );\n} : (), "## Keep!\n" ) : $result_expr{delete} ? ( $debugging ? qq{VCP::Debug::debug( "vcp: <<delete>>ing" );\n} : (), "\$rev->remove_label( \$_ );\n" ) : do { my $expr = $result_expr{label}; $expr =~ s{([\\"])}{\\$1}g; $expr =~ s{\n}{\\n}g; ( $debugging ? qq{VCP::Debug::debug( "vcp: rewriting \$_ to '$expr'" );\n} : (), qq{\$rev->remove_label( \$_ );\n}, qq{\$rev->add_label( "$expr" );\n}, ); } ); $result_statement =~ s/^/ /gm; $result_statement = "if ( $test_expr ) {\n$result_statement}\n"; $result_statement =~ s/^/ /gm; $result_statement; } sub _compile_rules { my VCP::Filter::labelmap $self = shift; ## NOTE: making this a closure causes spurious warnings at exit so ## we pass $self explicitly. my $preamble = <<END_PREAMBLE; my ( \$self, \$rev ) = \@_; END_PREAMBLE $preamble .= qq{my \$s = \$_; \$s =~ s/\\n/\\\\n/g; VCP::Debug::debug( "vcp: map testing '\$s' (", \$rev->as_string, ")" );\n\n} if explicitly_debugging $self; my $rule_number; my $code = join( "", $preamble, "for ( \$rev->labels ) {\n", map( $self->_compile_rule( @$_ ), map( [ "Rule " . ++$rule_number, @$_ ], @_ ), [ "Default Rule", undef, "<<keep>>" ] ), "}\n", "\$self->dest->handle_rev( \$rev )\n", ); $code =~ s/^/ /mg; $code = "#line 1 VCP::Filter::labelmap::labelmap_function\n$code"; $code = "sub {\n$code}"; debug "vcp: labelmap 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 ) = @_ ; ## NOTE: This routine is almost identical to one in VCP::Filter::map. ## maintain both, and if a third map filter is added like these two, ## factor out common code in to a base class. my $pattern; my @rules; while ( @$options ) { my $v = shift @$options; last if $v eq "--"; if ( ! defined $pattern ) { $pattern = $v; } else { push @rules, [ $pattern, $v ]; $pattern = undef; } } if ( debugging $self ) { require Data::Dumper; debug( "vcp: ", Data::Dumper->Dump( [ \@rules ], [ "labelmap_rules" ] ) ); } if ( $pattern ) { my @out = map [ map shell_quote( $_ ), @$_ ], @rules; my $pw = length "Pattern"; $pw = $_ > $pw ? $_ : $pw for map length $_->[0], @out; my $rw = length "Result"; $rw = $_ > $rw ? $_ : $rw for map length $_->[1], @out; die "Odd number of values in labelmap:\n\n", sprintf( "# %-${pw}s %s\n", "Pattern", "Result" ), sprintf( "# %-${pw}s %s\n", "=" x $pw, "=" x $rw ), map( sprintf( " %-${pw}s %s\n", @$_ ), @out ), sprintf( " %-${pw}s %s\n", shell_quote( $pattern ), "" ), "\n" if defined $pattern; } $self->{MAP_SUB} = $self->_compile_rules( @rules ); return $self ; } sub handle_rev { my VCP::Filter::labelmap $self = shift; $self->{MAP_SUB}->( $self, @_ ); } =head1 AUTHOR Barrie Slaymaker <barries@slaysys.com> =head1 COPYRIGHT Copyright (c) 2000, 2001, 2002 Perforce Software, Inc. All rights reserved. See L<VCP::License|VCP::License> (C<vcp help license>) for the terms of use. =cut 1
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#12 | 5404 | Barrie Slaymaker |
- SVN support added - Makefile gives clearer notices about missing optional prereqs. - VCP::Filter::labelmap and VCP::Filter::map: <<skip>> replaces deprecated <<delete>> to be clearer that no revisions are deleted from either repository but some just are skipped and not inserted. - VCP::Filter::map: support added for SVN-like branch labels - VCP::Source: support added for ISO8601 timestamps emitted by SVN. |
||
#11 | 4021 | Barrie Slaymaker |
- Remove all phashes and all base & fields pragmas - Work around SWASHGET error |
||
#10 | 4012 | Barrie Slaymaker | - Remove dependance on pseudohashes (deprecated Perl feature) | ||
#9 | 3930 | Barrie Slaymaker |
- VCP::Source::cvs and VCP::Dest::p4 handle cloning deletes - "placeholder" actions and is_placeholder_rev() deprecated in favor of is_branch_rev() and is_clone_rev(). - Misc cleanups and minor bugfixes |
||
#8 | 3465 | Barrie Slaymaker | - VCP::Filters can now dump they're sections. | ||
#7 | 3155 | Barrie Slaymaker |
Convert to logging using VCP::Logger to reduce stdout/err spew. Simplify & speed up debugging quite a bit. Provide more verbose information in logs. Print to STDERR progress reports to keep users from wondering what's going on. Breaks test; halfway through upgrading run3() to an inline function for speed and for VCP specific features. |
||
#6 | 3112 | Barrie Slaymaker |
Reduce memory footprint when handling large numbers of revisions. |
||
#5 | 3106 | Barrie Slaymaker |
Remove an unused field (state) from VCP::Rev optimize and bugfix labelmap |
||
#4 | 3091 | Barrie Slaymaker |
Factor out rules list parsing; it's useful elsewhere and should not have been copy & edited in to two files in the first place. |
||
#3 | 3089 | Barrie Slaymaker | Fix minor bug in error reporting. | ||
#2 | 3027 | Barrie Slaymaker | VCP::Filter::labelmap | ||
#1 | 3025 | Barrie Slaymaker | Prepare to add LabelMap directive (VCP::Filter::labelmap) |