From: Don Armstrong Date: Sat, 14 Jul 2012 17:14:59 +0000 (-0700) Subject: remove old DBase stuff X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=d4175c63586d2e715e0fb6f8ccfc918d73d3cb46;p=debbugs.git remove old DBase stuff --- diff --git a/Debbugs/DBase.pm b/Debbugs/DBase.pm deleted file mode 100644 index 5df78b01..00000000 --- a/Debbugs/DBase.pm +++ /dev/null @@ -1,289 +0,0 @@ -# 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; - -BEGIN { - use Exporter (); - use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - - # set the version for version checking - $VERSION = 1.00; - - @ISA = qw(Exporter); - @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(); -} - -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; - -my $OpenedRecord = 0; -my $OpenedLog = 0; -my $FileHandle; -my $LogfileHandle = new FileHandle; - -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; -} - -sub ReadRecord -{ - my ($recordnum, $with_log, $new) = (shift, shift, shift); - my @data; - my $record; - my $btags; - - #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' }; } - - #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: Loading status $recordnum\n" if $Globals{ 'debug' }; - seek( $FileHandle, 0, 0 ); - @data = <$FileHandle>; - - #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; -} - -1; - -END { } # module clean-up code here (global destructor) diff --git a/Debbugs/DBase/Log.pm b/Debbugs/DBase/Log.pm deleted file mode 100644 index 3e493b72..00000000 --- a/Debbugs/DBase/Log.pm +++ /dev/null @@ -1,75 +0,0 @@ -# TODO: Implement 'stale' checks, so that there is no need to explicitly -# write out a record, before closing. - -package Debbugs::DBase::Log; - -use strict; - -sub new -{ - my $self = {}; -# $self->{LOG} = new FileHandle; -# $self->{AGE} = undef; -# $self->{PEERS} = []; - $self->{log} = []; - bless ($self); - return $self; -} -my %logClass = (); -my %logType = (); -sub Register -{ - my ($char, $type, $class) = (shift, shift, shift); - $logClass{ $char } = $class; - $logType{ $char } = $type; - -} - -sub Load -{ - my ($self, $handle) = (shift, shift); - foreach (keys %$self) { -print "key=$_\n"; -} - while (<$handle>) { - chomp; - my ($char, $class, $type) = ($_, $logClass{ $_ }, $logType{ $_ }); - my $msg = ""; - while (<$handle>) { - chomp; - if ( $_ eq "\3" ) { - last; - } else { - $msg .= "$_\n"; - } - } - if( defined($class) ) { - print "found handler $type for $char\n"; - my $log = $class->new($msg); - - my @log = $self->{log}; - push @log, ($log); - } else { - print "undefined handler for $char\n"; - } - } -} - -BEGIN { - use Exporter (); - use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - - # set the version for version checking - $VERSION = 1.00; - - @ISA = qw(Exporter); - @EXPORT = qw(new); - %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], - - # your exported package globals go here, - # as well as any optionally exported functions - @EXPORT_OK = qw(); - -} - -1; diff --git a/Debbugs/DBase/Log/Html.pm b/Debbugs/DBase/Log/Html.pm deleted file mode 100644 index b0eca6b1..00000000 --- a/Debbugs/DBase/Log/Html.pm +++ /dev/null @@ -1,25 +0,0 @@ -# TODO: Implement 'stale' checks, so that there is no need to explicitly -# write out a record, before closing. - -package Debbugs::DBase::Log::Html; - -use strict; - -BEGIN { - Debbugs::DBase::Log::Register("\6", "Html", "Debbugs::DBase::Log::Html"); -} - - -sub new -{ - my $self = {}; - $self->{TYPE} = "Html"; - $self->{MSG} = shift; - bless ($self); - return $self; -} - -END { } # module clean-up code here (global destructor) - - -1; diff --git a/Debbugs/DBase/Log/Mail.pm b/Debbugs/DBase/Log/Mail.pm deleted file mode 100644 index 9d23c77d..00000000 --- a/Debbugs/DBase/Log/Mail.pm +++ /dev/null @@ -1,30 +0,0 @@ -# TODO: Implement 'stale' checks, so that there is no need to explicitly -# write out a record, before closing. - -package Debbugs::DBase::Log::Mail; -use Debbugs::DBase::LogEntry; -use Exporter; - -use strict; -BEGIN { - use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - @ISA = ( "Debbugs::DBase::LogEntry" ); - Debbugs::DBase::Log::Register("\2", "Mail", "Debbugs::DBase::Log::Mail"); -} - - -sub new -{ - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = {}; - $self->{TYPE} = "Html"; - $self->{MSG} = shift; - bless ($self, $class); - return $self; -} - -END { } # module clean-up code here (global destructor) - - -1; diff --git a/Debbugs/DBase/Log/Message.pm b/Debbugs/DBase/Log/Message.pm deleted file mode 100644 index ceebb121..00000000 --- a/Debbugs/DBase/Log/Message.pm +++ /dev/null @@ -1,25 +0,0 @@ -# TODO: Implement 'stale' checks, so that there is no need to explicitly -# write out a record, before closing. - -package Debbugs::DBase::Log::Message; - -use strict; - -BEGIN { - Debbugs::DBase::Log::Register("\7", "Message", "Debbugs::DBase::Log::Message"); -} - - -sub new -{ - my $self = {}; - $self->{TYPE} = "Message"; - $self->{MSG} = shift; - bless ($self); - return $self; -} - -END { } # module clean-up code here (global destructor) - - -1; diff --git a/Debbugs/DBase/LogEntry.pm b/Debbugs/DBase/LogEntry.pm deleted file mode 100644 index c9ec852f..00000000 --- a/Debbugs/DBase/LogEntry.pm +++ /dev/null @@ -1,69 +0,0 @@ -# TODO: Implement 'stale' checks, so that there is no need to explicitly -# write out a record, before closing. - -package Debbugs::DBase::LogEntry; - -use strict; - -sub new -{ - my $self = {}; -# $self->{LOG} = new FileHandle; -# $self->{AGE} = undef; -# $self->{PEERS} = []; - $self->{log} = []; - $self->{Load} = &Load; - bless ($self); - return $self; -} -my %logClass = (); -my %logType = (); - -sub Load -{ - my ($self, $handle) = (shift, shift); - foreach (keys %$self) { -print "key=$_\n"; -} - while (<$handle>) { - chomp; - my ($char, $class, $type) = ($_, $logClass{ $_ }, $logType{ $_ }); - my $msg = ""; - while (<$handle>) { - chomp; - if ( $_ eq "\3" ) { - last; - } else { - $msg .= "$_\n"; - } - } - if( defined($class) ) { - print "found handler $type for $char\n"; - my $log = $class->new($msg); - - my @log = $self->{log}; - push @log, ($log); - } else { - print "undefined handler for $char\n"; - } - } -} - -BEGIN { - use Exporter (); - use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - - # set the version for version checking - $VERSION = 1.00; - - @ISA = qw(Exporter); - @EXPORT = qw(new); - %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], - - # your exported package globals go here, - # as well as any optionally exported functions - @EXPORT_OK = qw(); - -} - -1;