]> git.donarmstrong.com Git - debbugs.git/blob - Debbugs/DBase.pm
fix how e-mails are passed to the avatar script
[debbugs.git] / Debbugs / DBase.pm
1 # TODO: Implement 'stale' checks, so that there is no need to explicitly
2 #       write out a record, before closing.
3
4 package Debbugs::DBase;  # assumes Some/Module.pm
5
6 use strict;
7
8 BEGIN {
9         use Exporter   ();
10         use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
11
12         # set the version for version checking
13         $VERSION     = 1.00;
14
15         @ISA         = qw(Exporter);
16         @EXPORT      = qw();
17         %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
18
19         # your exported package globals go here,
20         # as well as any optionally exported functions
21         @EXPORT_OK   = qw();
22 }
23
24 use vars      @EXPORT_OK;
25 use Fcntl ':flock';
26 use Debbugs::Config;
27 use Debbugs::Email;
28 use Debbugs::Common;
29 use Debbugs::DBase::Log;
30 use Debbugs::DBase::Log::Html;
31 use Debbugs::DBase::Log::Message;
32 use Debbugs::DBase::Log::Mail;
33
34 use FileHandle;
35 use File::Basename qw(&dirname);
36 use File::Path;
37
38 my $OpenedRecord = 0;
39 my $OpenedLog = 0;
40 my $FileHandle;
41 my $LogfileHandle = new FileHandle;
42
43 sub ParseVersion1Record
44 {
45     my @data = @_;
46     my @fields = ( "originator", "date", "subject", "msgid", "package",
47                 "keywords", "done", "forwarded", "mergedwith", "severity" );
48     my $i = 0;
49     my $tag;
50     my (%record, %btags);
51
52     print "D2: (DBase) Record Fields:\n" if $Globals{ 'debug' } > 1;
53     foreach my $line ( @data )
54     {
55         chop( $line );
56         $tag = $fields[$i];
57         $record{ $tag } = $line;
58         print "\t $tag = $line\n" if $Globals{ 'debug' } > 1;
59         $i++;
60         $btags{ "BUG_$tag" } = $line;
61     }
62     return ( \%record, \%btags );
63 }
64
65 sub ParseVersion2Record
66 {
67     # I envision the next round of records being totally different in
68     # meaning.  In order to maintain compatability, version tagging will be
69     # implemented in the next go around and different versions will be sent
70     # off to different functions to be parsed and interpreted into a format
71     # that the rest of the system will understand.  All data will be saved
72     # in whatever 'new" format exists.  The difference will be a "Version: x"
73     # at the top of the file.
74
75     print "No version 2 records are understood at this time\n";
76     exit 1;
77 }
78
79 sub ReadRecord
80 {
81     my ($recordnum, $with_log, $new) = (shift, shift, shift);
82     my @data;
83     my $record;
84     my $btags;
85
86     #Open Status File
87     print "V: Reading status $recordnum\n" if $Globals{ 'verbose' };
88     if( $OpenedRecord != $recordnum )
89     {
90         if( defined( $FileHandle ) )
91         {
92             print "D1: Closing status $recordnum\n" if $Globals{ 'debug' };
93             $OpenedRecord = 0;
94             close $FileHandle;
95             $FileHandle = undef;
96         }
97         print "D1: Opening status $recordnum\n" if $Globals{ 'debug' };
98         $FileHandle = &OpenFile( ["db", "archive"], $recordnum, ".status", "status", $new );
99         if( !defined( $FileHandle ) ) { return undef; }
100     }
101     else { print "D1: Reusing status $recordnum\n" if $Globals{ 'debug' }; }
102
103     #Lock status file
104     print "D1: Locking status $recordnum\n" if $Globals{ 'debug' };
105     flock( $FileHandle, LOCK_EX ) || &fail( "Unable to lock record $recordnum\n" );
106
107     #Read in status file contents
108     print "D1: Loading status $recordnum\n" if $Globals{ 'debug' };
109     seek( $FileHandle, 0, 0 );
110     @data = <$FileHandle>;
111
112     #Parse Status File Contents
113     if ( scalar( @data ) =~ /Version: (\d*)/ )
114     {
115         if ( $1 == 2 )
116         { &ParseVersion2Record( @data ); }
117         else
118         { &fail( "Unknown record version: $1\n"); }
119     }
120     else { ($record, $btags) = &ParseVersion1Record( @data ); }
121     if( $with_log )
122     {
123         #DO READ IN LOG RECORD DATA STUFF
124     }
125     return ($record, $btags);
126 }
127
128 sub WriteRecord
129 {
130     my ($recordnum, %record) = @_;
131     my @fields = ( "originator", "date", "subject", "msgid", "package",
132                 "keywords", "done", "forwarded", "mergedwith", "severity" );
133
134     #Open Status File
135     print "V: Writing status $recordnum\n" if $Globals{ 'verbose' };
136     if( $OpenedRecord != $recordnum )
137     {
138         if( defined( $FileHandle ) )
139         {
140             print "D1: Closing status $recordnum\n" if $Globals{ 'debug' };
141             $OpenedRecord = 0;
142             close $FileHandle;
143             $FileHandle = undef;
144         }
145         print "D1: Opening status $recordnum\n" if $Globals{ 'debug' };
146         $FileHandle = &OpenFile( ["db", "archive"], $recordnum, ".status", "status", "old" );
147         if( !defined( $FileHandle ) ) { return undef; }
148     }
149     else { print "D1: Reusing status $recordnum\n" if $Globals{ 'debug' }; }
150
151     #Lock status file
152     print "D1: Locking status $recordnum\n" if $Globals{ 'debug' };
153     flock( $FileHandle, LOCK_EX ) || &fail( "Unable to lock record $recordnum\n" );
154
155     #Read in status file contents
156     print "D1: Saving status $recordnum\n" if $Globals{ 'debug' };
157     seek( $FileHandle, 0, 0 );
158     for( my $i = 0; $i < $#fields; $i++ )
159     {
160         if ( defined( $record{ $fields[$i] } ) )
161         { print $FileHandle $record{ $fields[$i] } . "\n"; }
162         else { print $FileHandle "\n"; }
163     }
164 }
165
166 sub GetFileName
167 {
168     my ($prePaths, $stub, $postPath, $desc, $new) = (shift, shift, shift, shift, shift);
169     my $path;
170     foreach my $prePath (@$prePaths) {
171         $path = "/" . $prePath . "/" . $stub . $postPath;
172         print "V: Opening $desc $stub\n" if $Globals{ 'verbose' };
173         print "D2: (DBase) trying $path\n" if $Globals{ 'debug' } > 1;
174         if( ! -r $Globals{ "work-dir" } . $path ) {
175             $path = "/" . $prePath . "/" . &NameToPathHash($stub) . $postPath;
176             print "D2: (DBase) trying $path\n" if $Globals{ 'debug' } > 1;
177             if( ! -r $Globals{ "work-dir" } . $path ) {
178                 next if( !$new =~ "new" );
179             }
180         }
181         if( -r $Globals{ "work-dir" } . $path ) {
182             return $path;
183         }
184         if( ( ! -r $Globals{ "work-dir" } . $path ) && defined($new) && $new =~ "new") {
185             my $dir = dirname( $path );
186             if ( ! -d $Globals{ "work-dir" } . $dir ) {
187                 mkpath($Globals{ "work-dir" } . $dir);
188             }
189             return $path;
190         }
191     }
192     return undef;
193 }
194
195 sub OpenFile
196 {
197     my ($prePaths, $stub, $postPath, $desc, $new) = (shift, shift, shift, shift, shift);
198     my $fileName = GetFileName($prePaths, $stub, $postPath, $desc, $new);
199     my $handle = new FileHandle;
200     open( $handle, $Globals{ "work-dir" } . $fileName ) && return $handle;
201     return undef;
202 }
203
204 sub OpenLogfile
205 {
206     my $record = $_[0];
207     if ( $record ne $OpenedLog )
208     {
209         $LogfileHandle = OpenFile(["db", "archive"], $record, ".log", "log");
210         $OpenedLog = $record;
211     }
212 }
213
214 sub ReadLogfile
215 {
216     my $record = $_[0];
217     if ( $record eq $OpenedLog )
218     {
219         seek( $LogfileHandle, 0, 0 );
220         my $log = new Debbugs::DBase::Log;
221         $log->Load($LogfileHandle);
222     }
223 }
224
225 sub CloseLogfile
226 {
227     print "V: Closing log $OpenedLog\n" if $Globals{ 'verbose' };
228     close $LogfileHandle;
229     $OpenedLog = 0;
230 }
231 sub GetBugList
232 {
233 # TODO: This is ugly, but the easiest for me to implement.
234 #       If you have a better way, then please send a patch.
235 #
236     my $dir = new FileHandle;
237
238     my $prefix;
239     my $paths = shift;
240     my @paths;
241     if ( !defined($paths) ) {
242         @paths = ("db");
243     } else {
244         @paths = @$paths;
245     }
246     my @ret;
247     my $path;
248     foreach $path (@paths) {
249         $prefix = $Globals{ "work-dir" } . "/" . $path . "/";
250         opendir $dir, $prefix;
251         my @files = readdir($dir);
252         closedir $dir;
253         foreach (grep { /\d*\d\d.status/ } @files) {
254             next if ( ! -s $prefix . "/" . $_ );
255             s/.status$//;
256             push @ret, $_;
257 #           print "$_ -> $_\n";
258         }
259         foreach (grep { /^[s0-9]$/ } @files) {
260             my $_1 = $_;
261             opendir $dir, $prefix . $_1;
262             my @files = grep { /^\d$/ } readdir($dir);
263             closedir $dir;
264             foreach (@files) {
265                 my $_2 = $_;
266                 opendir $dir, "$prefix$_1/$_2";
267                 my @files = grep { /^\d$/ } readdir($dir);
268                 close $dir;
269                 foreach (@files) {
270                     my $_3 = $_;
271                     opendir $dir, "$prefix$_1/$_2/$_3";
272                     my @files = grep { /\d*\d\d.status/ } readdir($dir);
273                     close $dir;
274                     foreach (@files) {
275                         next if ( ! -s "$prefix$_1/$_2/$_3/$_" );
276                         s/.status$//;
277                         push @ret, $_;
278 #                       print "$_ -> $_1/$_2/$_3/$_\n";
279                     }
280                 }
281             }
282         }
283     }
284     return @ret;
285 }
286
287 1;
288
289 END { }       # module clean-up code here (global destructor)