File: Filter.pm

package info (click to toggle)
libvcp-perl 0.9-20050110-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 1,608 kB
  • ctags: 827
  • sloc: perl: 18,194; makefile: 42; sh: 11
file content (306 lines) | stat: -rw-r--r-- 6,299 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
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