From 8024495ba8532e95dea57b408c486f6b9a81b2df Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Tue, 28 Feb 2017 17:48:17 -0800 Subject: [PATCH] remove obsolete Debbugs::DBase and Debbugs::Email modules --- Debbugs/DBase.pm | 289 ----------------------------------- Debbugs/DBase/Log.pm | 75 --------- Debbugs/DBase/Log/Html.pm | 25 --- Debbugs/DBase/Log/Mail.pm | 30 ---- Debbugs/DBase/Log/Message.pm | 25 --- Debbugs/DBase/LogEntry.pm | 69 --------- Debbugs/Email.pm | 79 ---------- 7 files changed, 592 deletions(-) delete mode 100644 Debbugs/DBase.pm delete mode 100644 Debbugs/DBase/Log.pm delete mode 100644 Debbugs/DBase/Log/Html.pm delete mode 100644 Debbugs/DBase/Log/Mail.pm delete mode 100644 Debbugs/DBase/Log/Message.pm delete mode 100644 Debbugs/DBase/LogEntry.pm delete mode 100644 Debbugs/Email.pm diff --git a/Debbugs/DBase.pm b/Debbugs/DBase.pm deleted file mode 100644 index 5df78b0..0000000 --- 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 3e493b7..0000000 --- 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 b0eca6b..0000000 --- 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 9d23c77..0000000 --- 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 ceebb12..0000000 --- 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 c9ec852..0000000 --- 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; diff --git a/Debbugs/Email.pm b/Debbugs/Email.pm deleted file mode 100644 index 980b5fb..0000000 --- a/Debbugs/Email.pm +++ /dev/null @@ -1,79 +0,0 @@ -package Debbugs::Email; - -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( %GTags ); - %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], - - # your exported package globals go here, - # as well as any optionally exported functions - @EXPORT_OK = qw( %GTags ); -} - -use vars @EXPORT_OK; -use Debbugs::Config qw(%Globals); - -# initialize package globals, first exported ones -%GTags= ( ); - -############################################################################# -# Initialize Global Tags -############################################################################# -sub InitEmailTags -{ my @config = @_; - - print "V: Initializing Email Tags\n" if $Globals{ 'verbose' }; - for( my $i=0; $i<=$#config; $i++) - { $_ = $config[$i]; - chop $_; - next unless length $_; - next if /^#/; - if ( /^GTAG\s*[:=]\s*(\S)+\s*[:=]\s*([^#]*)/i ) - { $GTags{ $1 } = $2; - print "D2: (email) GTag $1=$GTags{$1}\n" if $Globals{ 'debug' } > 1; - } - } -} - -############################################################################# -# Load File with Tags -############################################################################# -sub LoadEmail -{ my $emailfile = $_[0]; - my @email; - - open( LETTER, $emailfile ) or &::fail( "Unable to open $emailfile: $!" ); - @email = ; - close LETTER; - &ProcessTags( \@email, \%GTags, "GTAG" ); - return @email; -} -############################################################################# -# Process Tags -############################################################################# -sub ProcessTags -{ my ($email, $tagsin, $marker) = @_; - my %tags=%$tagsin; - my $tag; - - print "V: Processing Template Mail\n" if $Globals{ 'verbose' }; - foreach my $line ( @$email ) - { while( $line =~ /\%$marker\_(\S*)\%/s ) - { if( defined( $tags{ $1 } ) ) { $tag = $tags{ $1 }; } - else { $tag = "(missed tag $1)"; } - $line =~ s/\%$marker\_(\S*)\%/$tag/; - } - } - 1; -} - -END { } # module clean-up code here (global destructor) -1; -- 2.39.2