-package Debvote::Rank; # assumes Some/Module.pm
+# TODO: Implement 'stale' checks, so that there is no need to explicitly
+# write out a record, before closing.
+
+package Debbugs::DBase; # assumes Some/Module.pm
use strict;
$VERSION = 1.00;
@ISA = qw(Exporter);
- @EXPORT = qw(&func1 &func2 &func4);
+ @EXPORT = qw();
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
# your exported package globals go here,
# as well as any optionally exported functions
- @EXPORT_OK = qw($Var1 %Hashit &func3);
+ @EXPORT_OK = qw();
}
use vars @EXPORT_OK;
+use Fcntl ':flock';
+use Debbugs::Config;
+use Debbugs::Email;
+use Debbugs::Common;
+use Debbugs::DBase::Log;
+use Debbugs::DBase::Log::Html;
+use Debbugs::DBase::Log::Message;
+use Debbugs::DBase::Log::Mail;
+
+use FileHandle;
+use File::Basename qw(&dirname);
+use File::Path;
-# non-exported package globals go here
-use vars qw(@more $stuff);
+my $OpenedRecord = 0;
+my $OpenedLog = 0;
+my $FileHandle;
+my $LogfileHandle = new FileHandle;
-# initialize package globals, first exported ones
-$Var1 = '';
-%Hashit = ();
+sub ParseVersion1Record
+{
+ my @data = @_;
+ my @fields = ( "originator", "date", "subject", "msgid", "package",
+ "keywords", "done", "forwarded", "mergedwith", "severity" );
+ my $i = 0;
+ my $tag;
+ my (%record, %btags);
+
+ print "D2: (DBase) Record Fields:\n" if $Globals{ 'debug' } > 1;
+ foreach my $line ( @data )
+ {
+ chop( $line );
+ $tag = $fields[$i];
+ $record{ $tag } = $line;
+ print "\t $tag = $line\n" if $Globals{ 'debug' } > 1;
+ $i++;
+ $btags{ "BUG_$tag" } = $line;
+ }
+ return ( \%record, \%btags );
+}
+
+sub ParseVersion2Record
+{
+ # I envision the next round of records being totally different in
+ # meaning. In order to maintain compatability, version tagging will be
+ # implemented in the next go around and different versions will be sent
+ # off to different functions to be parsed and interpreted into a format
+ # that the rest of the system will understand. All data will be saved
+ # in whatever 'new" format exists. The difference will be a "Version: x"
+ # at the top of the file.
+
+ print "No version 2 records are understood at this time\n";
+ exit 1;
+}
-# then the others (which are still accessible as
-# $Some::Module::stuff)
-$stuff = '';
-@more = ();
+sub ReadRecord
+{
+ my ($recordnum, $with_log, $new) = (shift, shift, shift);
+ my @data;
+ my $record;
+ my $btags;
-# all file-scoped lexicals must be created before
-# the functions below that use them.
+ #Open Status File
+ print "V: Reading status $recordnum\n" if $Globals{ 'verbose' };
+ if( $OpenedRecord != $recordnum )
+ {
+ if( defined( $FileHandle ) )
+ {
+ print "D1: Closing status $recordnum\n" if $Globals{ 'debug' };
+ $OpenedRecord = 0;
+ close $FileHandle;
+ $FileHandle = undef;
+ }
+ print "D1: Opening status $recordnum\n" if $Globals{ 'debug' };
+ $FileHandle = &OpenFile( ["db", "archive"], $recordnum, ".status", "status", $new );
+ if( !defined( $FileHandle ) ) { return undef; }
+ }
+ else { print "D1: Reusing status $recordnum\n" if $Globals{ 'debug' }; }
-# file-private lexicals go here
-my $priv_var = '';
-my %secret_hash = ();
+ #Lock status file
+ print "D1: Locking status $recordnum\n" if $Globals{ 'debug' };
+ flock( $FileHandle, LOCK_EX ) || &fail( "Unable to lock record $recordnum\n" );
-# here's a file-private function as a closure,
-# callable as &$priv_func; it cannot be prototyped.
-my $priv_func = sub {
-# stuff goes here.
-};
+ #Read in status file contents
+ print "D1: Loading status $recordnum\n" if $Globals{ 'debug' };
+ seek( $FileHandle, 0, 0 );
+ @data = <$FileHandle>;
-# make all your functions, whether exported or not;
-# remember to put something interesting in the {} stubs
-sub func1 {} # no prototype
-sub func2() {} # proto'd void
-sub func3($$) {} # proto'd to 2 scalars
+ #Parse Status File Contents
+ if ( scalar( @data ) =~ /Version: (\d*)/ )
+ {
+ if ( $1 == 2 )
+ { &ParseVersion2Record( @data ); }
+ else
+ { &fail( "Unknown record version: $1\n"); }
+ }
+ else { ($record, $btags) = &ParseVersion1Record( @data ); }
+ if( $with_log )
+ {
+ #DO READ IN LOG RECORD DATA STUFF
+ }
+ return ($record, $btags);
+}
+
+sub WriteRecord
+{
+ my ($recordnum, %record) = @_;
+ my @fields = ( "originator", "date", "subject", "msgid", "package",
+ "keywords", "done", "forwarded", "mergedwith", "severity" );
+
+ #Open Status File
+ print "V: Writing status $recordnum\n" if $Globals{ 'verbose' };
+ if( $OpenedRecord != $recordnum )
+ {
+ if( defined( $FileHandle ) )
+ {
+ print "D1: Closing status $recordnum\n" if $Globals{ 'debug' };
+ $OpenedRecord = 0;
+ close $FileHandle;
+ $FileHandle = undef;
+ }
+ print "D1: Opening status $recordnum\n" if $Globals{ 'debug' };
+ $FileHandle = &OpenFile( ["db", "archive"], $recordnum, ".status", "status", "old" );
+ if( !defined( $FileHandle ) ) { return undef; }
+ }
+ else { print "D1: Reusing status $recordnum\n" if $Globals{ 'debug' }; }
+
+ #Lock status file
+ print "D1: Locking status $recordnum\n" if $Globals{ 'debug' };
+ flock( $FileHandle, LOCK_EX ) || &fail( "Unable to lock record $recordnum\n" );
+
+ #Read in status file contents
+ print "D1: Saving status $recordnum\n" if $Globals{ 'debug' };
+ seek( $FileHandle, 0, 0 );
+ for( my $i = 0; $i < $#fields; $i++ )
+ {
+ if ( defined( $record{ $fields[$i] } ) )
+ { print $FileHandle $record{ $fields[$i] } . "\n"; }
+ else { print $FileHandle "\n"; }
+ }
+}
+
+sub GetFileName
+{
+ my ($prePaths, $stub, $postPath, $desc, $new) = (shift, shift, shift, shift, shift);
+ my $path;
+ foreach my $prePath (@$prePaths) {
+ $path = "/" . $prePath . "/" . $stub . $postPath;
+ print "V: Opening $desc $stub\n" if $Globals{ 'verbose' };
+ print "D2: (DBase) trying $path\n" if $Globals{ 'debug' } > 1;
+ if( ! -r $Globals{ "work-dir" } . $path ) {
+ $path = "/" . $prePath . "/" . &NameToPathHash($stub) . $postPath;
+ print "D2: (DBase) trying $path\n" if $Globals{ 'debug' } > 1;
+ if( ! -r $Globals{ "work-dir" } . $path ) {
+ next if( !$new =~ "new" );
+ }
+ }
+ if( -r $Globals{ "work-dir" } . $path ) {
+ return $path;
+ }
+ if( ( ! -r $Globals{ "work-dir" } . $path ) && defined($new) && $new =~ "new") {
+ my $dir = dirname( $path );
+ if ( ! -d $Globals{ "work-dir" } . $dir ) {
+ mkpath($Globals{ "work-dir" } . $dir);
+ }
+ return $path;
+ }
+ }
+ return undef;
+}
+
+sub OpenFile
+{
+ my ($prePaths, $stub, $postPath, $desc, $new) = (shift, shift, shift, shift, shift);
+ my $fileName = GetFileName($prePaths, $stub, $postPath, $desc, $new);
+ my $handle = new FileHandle;
+ open( $handle, $Globals{ "work-dir" } . $fileName ) && return $handle;
+ return undef;
+}
+
+sub OpenLogfile
+{
+ my $record = $_[0];
+ if ( $record ne $OpenedLog )
+ {
+ $LogfileHandle = OpenFile(["db", "archive"], $record, ".log", "log");
+ $OpenedLog = $record;
+ }
+}
+
+sub ReadLogfile
+{
+ my $record = $_[0];
+ if ( $record eq $OpenedLog )
+ {
+ seek( $LogfileHandle, 0, 0 );
+ my $log = new Debbugs::DBase::Log;
+ $log->Load($LogfileHandle);
+ }
+}
+
+sub CloseLogfile
+{
+ print "V: Closing log $OpenedLog\n" if $Globals{ 'verbose' };
+ close $LogfileHandle;
+ $OpenedLog = 0;
+}
+sub GetBugList
+{
+# TODO: This is ugly, but the easiest for me to implement.
+# If you have a better way, then please send a patch.
+#
+ my $dir = new FileHandle;
+
+ my $prefix;
+ my $paths = shift;
+ my @paths;
+ if ( !defined($paths) ) {
+ @paths = ("db");
+ } else {
+ @paths = @$paths;
+ }
+ my @ret;
+ my $path;
+ foreach $path (@paths) {
+ $prefix = $Globals{ "work-dir" } . "/" . $path . "/";
+ opendir $dir, $prefix;
+ my @files = readdir($dir);
+ closedir $dir;
+ foreach (grep { /\d*\d\d.status/ } @files) {
+ next if ( ! -s $prefix . "/" . $_ );
+ s/.status$//;
+ push @ret, $_;
+# print "$_ -> $_\n";
+ }
+ foreach (grep { /^[s0-9]$/ } @files) {
+ my $_1 = $_;
+ opendir $dir, $prefix . $_1;
+ my @files = grep { /^\d$/ } readdir($dir);
+ closedir $dir;
+ foreach (@files) {
+ my $_2 = $_;
+ opendir $dir, "$prefix$_1/$_2";
+ my @files = grep { /^\d$/ } readdir($dir);
+ close $dir;
+ foreach (@files) {
+ my $_3 = $_;
+ opendir $dir, "$prefix$_1/$_2/$_3";
+ my @files = grep { /\d*\d\d.status/ } readdir($dir);
+ close $dir;
+ foreach (@files) {
+ next if ( ! -s "$prefix$_1/$_2/$_3/$_" );
+ s/.status$//;
+ push @ret, $_;
+# print "$_ -> $_1/$_2/$_3/$_\n";
+ }
+ }
+ }
+ }
+ }
+ return @ret;
+}
-# this one isn't exported, but could be called!
-sub func4(\%) {} # proto'd to 1 hash ref
+1;
END { } # module clean-up code here (global destructor)
projects / debbugs.git / blobdiff