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 );
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 );
30 use File::Basename qw(&basename);
38 my $FileHandle = new FileHandle;
39 my $LogfileHandle = new FileHandle;
41 sub ParseVersion1Record
44 my @fields = ( "originator", "date", "subject", "msgid", "package",
45 "keywords", "done", "forwarded", "mergedwith", "severity" );
49 print "D2: (DBase) Record Fields:\n" if $Globals{ 'debug' } > 1;
50 foreach my $line ( @data )
54 $Record{ $tag } = $line;
55 print "\t $tag = $line\n" if $Globals{ 'debug' } > 1;
57 $GTags{ "BUG_$tag" } = $line;
61 sub ParseVersion2Record
63 # I envision the next round of records being totally different in
64 # meaning. In order to maintain compatability, version tagging will be
65 # implemented in thenext go around and different versions will be sent
66 # off to different functions to be parsed and interpreted into a format
67 # that the rest of the system will understand. All data will be saved
68 # in whatever 'new" format ixists. The difference will be a "Version: x"
69 # at the top of the file.
71 print "No version 2 records are understood at this time\n";
78 print "V: Reading status $record\n" if $Globals{ 'verbose' };
79 if ( $record ne $LoadedRecord )
83 seek( $FileHandle, 0, 0 );
84 @data = <$FileHandle>;
85 if ( scalar( @data ) =~ /Version: (\d*)/ )
88 { &ParseVersion2Record( @data ); }
90 { &fail( "Unknown record version: $1\n"); }
92 else { &ParseVersion1Record( @data ); }
93 $LoadedRecord = $record;
95 else { print "D1: (DBase) $record is already loaded\n" if $Globals{ 'debug' }; }
101 my @fields = ( "originator", "date", "subject", "msgid", "package",
102 "keywords", "done", "forwarded", "mergedwith", "severity" );
103 print "V: Writing status $LoadedRecord\n" if $Globals{ 'verbose' };
104 seek( $FileHandle, 0, 0 );
105 for( my $i = 0; $i < $#fields; $i++ )
107 if ( defined( $fields[$i] ) )
108 { print $FileHandle $Record{ $fields[$i] } . "\n"; }
109 else { print $FileHandle "\n"; }
115 my $prePath = $_[0], my $stub = $_[1], my $postPath = $_[2], my $desc = $_[3];
116 my $path = "/db/".$stub.".status", my $handle = new FileHandle;
117 print "V: Opening $desc $stub\n" if $Globals{ 'verbose' };
118 print "D2: (DBase) $path found as data path\n" if $Globals{ 'debug' } > 1;
119 if( ! -r $Globals{ "work-dir" } . $path ) {
121 $path = $prePath. &NameToPathHash($stub) .$postPath;
122 $dir = basename($path);
123 if( ! -d $Globals{ "work-dir" } . $dir ) {
124 print "D1 (DBase) making dir $dir\n" if $Globals{ 'debug' };
125 mkdir $Globals{ "work-dir" } . $dir, umask();
128 open( $handle, $Globals{ "work-dir" } . $path )
129 || &fail( "Unable to open $desc: ".$Globals{ "work-dir" }."$path\n");
135 if ( $record ne $OpenedRecord )
137 $FileHandle = OpenFile("/db/", $record, ".status", "status");
138 flock( $FileHandle, LOCK_EX ) || &fail( "Unable to lock record $record\n" );
139 $OpenedRecord = $record;
145 print "V: Closing status $LoadedRecord\n" if $Globals{ 'verbose' };
153 if ( $record ne $OpenedLog )
155 $LogfileHandle = OpenFile("/db/", $record, ".log", "log");
156 seek( $FileHandle, 0, 2 );
157 $OpenedLog = $record;
163 print "V: Closing log $OpenedLog\n" if $Globals{ 'verbose' };
164 close $LogfileHandle;
169 # TODO: This is ugly, but the easiest for me to implement.
170 # If you have a better way, then please send a patch.
172 my $dir = new FileHandle;
175 opendir $dir, $Globals{ "work-dir" } . "/db";
176 my @files = readdir($dir);
178 foreach (grep { /\d*\d\d.status/ } @files) {
181 # print "$_ -> $_\n";
183 foreach (grep { /^[s0-9]$/ } @files) {
185 opendir $dir, $Globals{ "work-dir" } . "/db/".$_1;
186 @files = grep { /^\d$/ } readdir($dir);
190 opendir $dir, $Globals{ "work-dir" } . "/db/".$_1."/".$_2;
191 @files = grep { /^\d$/ } readdir($dir);
195 opendir $dir, $Globals{ "work-dir" } . "/db/".$_1."/".$_2."/".$_3;
196 @files = grep { /\d*\d\d.status/ } readdir($dir);
201 # print "$_ -> $_1/$_2/$_3/$_\n";
211 END { } # module clean-up code here (global destructor)