1 # TODO: Implement 'stale' checks, so that there is no need to explicitly
2 # write out a record, before closing.
4 package Debbugs::DBase; # assumes Some/Module.pm
10 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
12 # set the version for version checking
16 @EXPORT = qw( %Record %BTags);
17 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
19 # your exported package globals go here,
20 # as well as any optionally exported functions
21 @EXPORT_OK = qw( %Record %BTags);
29 use Debbugs::DBase::Log;
30 use Debbugs::DBase::Log::Html;
31 use Debbugs::DBase::Log::Message;
32 use Debbugs::DBase::Log::Mail;
35 use File::Basename qw(&dirname);
45 my $FileHandle = new FileHandle;
46 my $LogfileHandle = new FileHandle;
48 sub ParseVersion1Record
51 my @fields = ( "originator", "date", "subject", "msgid", "package",
52 "keywords", "done", "forwarded", "mergedwith", "severity" );
56 print "D2: (DBase) Record Fields:\n" if $Globals{ 'debug' } > 1;
57 foreach my $line ( @data )
61 $Record{ $tag } = $line;
62 print "\t $tag = $line\n" if $Globals{ 'debug' } > 1;
64 $BTags{ "BUG_$tag" } = $line;
68 sub ParseVersion2Record
70 # I envision the next round of records being totally different in
71 # meaning. In order to maintain compatability, version tagging will be
72 # implemented in thenext go around and different versions will be sent
73 # off to different functions to be parsed and interpreted into a format
74 # that the rest of the system will understand. All data will be saved
75 # in whatever 'new" format ixists. The difference will be a "Version: x"
76 # at the top of the file.
78 print "No version 2 records are understood at this time\n";
85 print "V: Reading status $record\n" if $Globals{ 'verbose' };
86 if ( $record ne $LoadedRecord )
90 seek( $FileHandle, 0, 0 );
91 @data = <$FileHandle>;
92 if ( scalar( @data ) =~ /Version: (\d*)/ )
95 { &ParseVersion2Record( @data ); }
97 { &fail( "Unknown record version: $1\n"); }
99 else { &ParseVersion1Record( @data ); }
100 $LoadedRecord = $record;
102 else { print "D1: (DBase) $record is already loaded\n" if $Globals{ 'debug' }; }
108 my @fields = ( "originator", "date", "subject", "msgid", "package",
109 "keywords", "done", "forwarded", "mergedwith", "severity" );
110 print "V: Writing status $LoadedRecord\n" if $Globals{ 'verbose' };
111 seek( $FileHandle, 0, 0 );
112 for( my $i = 0; $i < $#fields; $i++ )
114 if ( defined( $fields[$i] ) )
115 { print $FileHandle $Record{ $fields[$i] } . "\n"; }
116 else { print $FileHandle "\n"; }
122 my ($prePaths, $stub, $postPath, $desc, $new) = (shift, shift, shift, shift, shift);
124 foreach my $prePath (@$prePaths) {
125 $path = "/" . $prePath . "/" . $stub . $postPath;
126 print "V: Opening $desc $stub\n" if $Globals{ 'verbose' };
127 print "D2: (DBase) trying $path\n" if $Globals{ 'debug' } > 1;
128 if( ! -r $Globals{ "work-dir" } . $path ) {
129 $path = "/" . $prePath . "/" . &NameToPathHash($stub) . $postPath;
130 print "D2: (DBase) trying $path\n" if $Globals{ 'debug' } > 1;
131 if( ! -r $Globals{ "work-dir" } . $path ) {
132 next if( !$new =~ "new" );
135 if( -r $Globals{ "work-dir" } . $path ) {
138 if( ( ! -r $Globals{ "work-dir" } . $path ) && defined($new) && $new =~ "new") {
139 my $dir = dirname( $path );
140 if ( ! -d $Globals{ "work-dir" } . $dir ) {
141 mkpath($Globals{ "work-dir" } . $dir);
150 my ($prePaths, $stub, $postPath, $desc, $new) = (shift, shift, shift, shift, shift);
151 my $fileName = GetFileName($prePaths, $stub, $postPath, $desc, $new);
152 my $handle = new FileHandle;
153 open( $handle, $Globals{ "work-dir" } . $fileName ) && return $handle;
160 if ( $record ne $OpenedRecord )
162 $FileHandle = OpenFile ["db", "archive"], $record, ".status", "status", $_[1];
163 flock( $FileHandle, LOCK_EX ) || &fail( "Unable to lock record $record\n" );
164 $OpenedRecord = $record;
170 print "V: Closing status $LoadedRecord\n" if $Globals{ 'verbose' };
178 if ( $record ne $OpenedLog )
180 $LogfileHandle = OpenFile(["db", "archive"], $record, ".log", "log");
181 $OpenedLog = $record;
188 if ( $record eq $OpenedLog )
190 seek( $LogfileHandle, 0, 0 );
191 my $log = new Debbugs::DBase::Log;
192 $log->Load($LogfileHandle);
198 print "V: Closing log $OpenedLog\n" if $Globals{ 'verbose' };
199 close $LogfileHandle;
204 # TODO: This is ugly, but the easiest for me to implement.
205 # If you have a better way, then please send a patch.
207 my $dir = new FileHandle;
212 if ( !defined($paths) ) {
219 foreach $path (@paths) {
220 $prefix = $Globals{ "work-dir" } . "/" . $path . "/";
221 opendir $dir, $prefix;
222 my @files = readdir($dir);
224 foreach (grep { /\d*\d\d.status/ } @files) {
225 next if ( ! -s $prefix . "/" . $_ );
228 # print "$_ -> $_\n";
230 foreach (grep { /^[s0-9]$/ } @files) {
232 opendir $dir, $prefix . $_1;
233 my @files = grep { /^\d$/ } readdir($dir);
237 opendir $dir, "$prefix$_1/$_2";
238 my @files = grep { /^\d$/ } readdir($dir);
242 opendir $dir, "$prefix$_1/$_2/$_3";
243 my @files = grep { /\d*\d\d.status/ } readdir($dir);
246 next if ( ! -s "$prefix$_1/$_2/$_3/$_" );
249 # print "$_ -> $_1/$_2/$_3/$_\n";
260 END { } # module clean-up code here (global destructor)