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
|
package VCP::Revs ;
=head1 NAME
VCP::Revs - A collection of VCP::Rev objects.
=head1 SYNOPSIS
=head1 DESCRIPTION
Right now, all revs are kept in memory, but we will enable storing them to
disk and recovering them at some point so that we don't gobble huge
tracts of RAM.
=head1 METHODS
=over
=cut
$VERSION = 1 ;
use strict ;
use VCP::Logger qw( BUG );
use VCP::Debug ":debug" ;
use VCP::DB_File::big_records;
use VCP::Rev ;
use VCP::Utils qw( empty );
=item new
=cut
sub new {
my $class = shift;
my $self = bless { @_ }, $class;
BUG "STORE_LOC not set" if empty $self->{STORE_LOC};
return $self ;
}
sub revs_db {
my $self = shift;
my $plugin_name = $self->{PLUGIN_NAME};
$plugin_name = "" unless defined $plugin_name;
$plugin_name =~ s/::/-/g;
return $self->{REVS_DB} ||= do {
my $db = VCP::DB_File::big_records->new(
StoreLoc => $self->{STORE_LOC},
TableName => "$plugin_name-revs",
);
$db->delete_db;
$db->open_db;
$db;
};
}
sub DESTROY {
my $self = shift;
if ( $self->{REVS_DB} ) {
$self->{REVS_DB}->close_db;
$self->{REVS_DB}->delete_db;
}
}
=item add
$revs->add( $rev ) ;
$revs->add( $rev1, $rev2, ... ) ;
Adds a revision or revisions to the collection.
The ( name, rev_id, branch_id ) tuple must be unique, if a second rev
is C<add()>ed with the same values, an exception is thrown.
=cut
sub added_rev {
my $self = CORE::shift ;
my ( $id ) = @_;
return $self->revs_db->exists( [ $id ] );
}
sub add {
my $self = CORE::shift ;
Carp::confess "undef passed" if grep ! defined, @_;
if ( debugging ) {
debug "queuing ", $_->as_string for @_ ;
}
for my $r ( @_ ) {
my $id = $r->id;
BUG "can't add same revision twice: '" . $r->as_string
if $self->added_rev( $id );
$self->revs_db->set( [ $id ], $r->serialize );
}
}
=item get
$rev = $revs->get( $id ) ; ## return the rev with a given ID (or die())
=cut
sub get {
my $self = CORE::shift ;
BUG "can't retrieve all revs at once any more" unless @_;
my @fields = $self->revs_db->get( [ @_ ] );
return undef unless @fields;
return VCP::Rev->deserialize( @fields );
}
=item foreach
$revs->foreach( sub { ... } );
Apply a subroutine to each revision.
=cut
sub foreach {
my $self = shift;
my ( $sub ) = @_;
$self->revs_db->foreach_record_do(
sub {
my $r = VCP::Rev->deserialize( @_ );
$sub->( $r );
}
);
}
=back
=head1 SUBCLASSING
This class uses the fields pragma, so you'll need to use base and
possibly fields in any subclasses.
=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
|
