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<VCP::Dest|VCP::Dest>)
=cut
sub last_rev_in_filebranch {
shift->dest->last_rev_in_filebranch( @_ );
}
=item backfill
(passthru; see L<VCP::Dest|VCP::Dest>)
=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<vcp>.
=head1 AUTHOR
Barrie Slaymaker <barries@slaysys.com>
=cut
1
syntax highlighted by Code2HTML, v. 0.9.1