package VCP::Filter ; =head1 NAME VCP::Filter - A base class for filters =head1 SYNOPSIS use VCP::Filter; @ISA = qw( VCP::Filter ); ... =head1 DESCRIPTION A VPC::Filter is a VCP::Plugin that is placed between the source and the destination and allows the stream of revisions to be altered. For instance, the Map: option in vcp files is implemented by VCP::Filter::Map By default a filter is a pass-through. =cut $VERSION = 0.1 ; @ISA = qw( VCP::Plugin ); use strict; use Carp (); use VCP::ConfigFileUtils qw( config_file_quote ); use VCP::Debug qw( :debug ); use VCP::Logger qw( pr lg BUG ); use VCP::Plugin; use VCP::Utils qw( empty ); #use base "VCP::Plugin"; #use fields ( # 'PRETTY_PRINTED_RULES_LIST_LINES', # ## The list of rules that was parsed so that it # ## may be regurgitated in to a config file # 'DEST', ## Points to the next filter. #); sub dest { my $self = shift; $self->{DEST} = shift if @_; return $self->{DEST}; } ############################################################################### =head1 SUBCLASSING This class uses the fields pragma, so you'll need to use base and possibly fields in any subclasses. =over =item parse_rules_list Used in VCP::Filter::*map and VCP::Filter::*edit to parse lists of rules where every rule is a set of N "words". The value of N is computed from the number of labels passed in and the labels are used when printing an error message: @rules = $self->parse_rules( $options, "Pattern", "Replacement" ); =cut sub parse_rules_list { my $self = shift; my $options = shift; my $default = @_ && ref $_[-1] ? pop : []; my @labels = @_; my $expression_count = @labels; BUG "No expression labels passed" unless $expression_count; BUG "No options " unless $options; my @rule; my $rules; while ( @$options ) { my $v = shift @$options; last if $v eq "--"; push @rule, $v; push @$rules, [splice @rule] if @rule == $expression_count; } push @$rules, \@rule if @rule; $rules = $default unless $rules || @rule; ## Format pretty rules for the log, error messages, or later output ## to config file. my @out = map [ map config_file_quote( $_ ), @$_ ], @$rules; my @w; for ( \@labels, @out ) { for my $i (0..$#$_) { $w[$i] = length $_->[$i] if ! defined $w[$i] || length $_->[$i] > $w[$i]; } } ( my $filter_type = ref $self ) =~ s/.*://; ## space out the format to make it easier to edit ## in overwrite mode. while (1) { my $width = @w - 1; $width += $_ for @w; last if $width >= 64 - @w; ## 64 because we want 8 chars to left ## and to right. ++$_ for @w; } my $format = join " ", map "%-${_}s", @w; my @msg = ( sprintf( "# $format\n", @labels ), sprintf( "# $format\n", map "=" x $_, @w ), map( sprintf( " $format\n", map defined $_ ? $_ : "", @$_ ), @out ), " \n" ); die "incomplete rule in $filter_type:\n\n", @msg, "\n" if @rule; lg "$filter_type rules:\n", @msg; ## Take a copy in case the caller decides to alter the rules. $self->{PRETTY_PRINTED_RULES_LIST_LINES} = \@msg; return $rules; } =item filter_name Returns the StudlyCaps version of the filter name. By default, assumes a single work name and uses ucfirst on it. Filters like StringEdit should overload this to be more creative and typgraphically appealing (heh). =cut sub filter_name { my $self = shift; my ( $filtername ) = ( ref( $self ) =~ /\AVCP::Filter::(\w+)\z/ ) or BUG "Can't parse filter name from ", ref $self; return ucfirst $filtername; } =item sort_keys my @output_sort_order = $filter->sort_keys( @input_sort_order ); Accepts a list of sort keys from the upstream filter and returns a list of sort keys representing the order that records will be emitted in. This is a pass-through by default, but VCP::Filter::sort and VCP::Filter::changesets return appropriate values. =cut sub sort_keys { my $self = shift; return @_; } =item config_file_section_as_string =cut sub config_file_section_as_string { my $self = shift; require VCP::Help; my $section_name = $self->filter_name; my $plugin_docs = $self->plugin_documentation; return join "", "$section_name:\n", $self->{PRETTY_PRINTED_RULES_LIST_LINES} ? map " $_", @{$self->{PRETTY_PRINTED_RULES_LIST_LINES}} : (), !empty( $plugin_docs ) ? $self->_reformat_docs_as_comments( $plugin_docs ) : (), "\n"; } =item last_rev_in_filebranch (passthru; see L) =cut sub last_rev_in_filebranch { shift->dest->last_rev_in_filebranch( @_ ); } =item backfill (passthru; see L) =cut sub backfill { shift->dest->backfill( @_ ); } =item handle_header (passthru) =cut sub handle_header { my $self = shift; $self->{SKIPPED_REV_COUNT} = 0; $self->dest->handle_header( @_ ); } =item rev_count $self->SUPER::rev_count( @_ ); passthru, see VCP::Dest. =cut sub rev_count { shift->dest->rev_count( @_ ); } =item handle_rev $self->SUPER::handle_rev( @_ ); passthru, see VCP::Dest. =cut sub handle_rev { shift->dest->handle_rev( @_ ); } =item skip_rev $self->SUPER::skip_rev( @_ ); passthru, see VCP::Dest =cut sub _skip_rev { ## _skip_rev() silently passes this on, skip_rev() announces it shift->dest->_skip_rev( @_ ); } sub skip_rev { my $self = shift; ++$self->{SKIPPED_REV_COUNT}; $self->_skip_rev; } =item handle_footer $self->SUPER::handle_footer( @_ ); passthru, see VCP::Dest =cut sub handle_footer { my $self = shift; pr $self->filter_name, " filter skipped $self->{SKIPPED_REV_COUNT} revisions" if $self->{SKIPPED_REV_COUNT}; $self->dest->handle_footer( @_ ); } =back =head1 COPYRIGHT Copyright 2000, Perforce Software, Inc. All Rights Reserved. This module and the VCP package are licensed according to the terms given in the file LICENSE accompanying this distribution, a copy of which is included in L. =head1 AUTHOR Barrie Slaymaker =cut 1