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( %Record %BTags);
  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( %Record %BTags);
  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 %Record = ();
  39 %BTags= ( );
  40
  41 my $LoadedRecord = 0;
  42 my $OpenedRecord = 0;
  43 my $OpenedLog = 0;
  44 my $FileLocked = 0;
  45 my $FileHandle = new FileHandle;
  46 my $LogfileHandle = new FileHandle;
  47
  48 sub ParseVersion1Record
  49 {
  50     my @data = @_;
  51     my @fields = ( "originator", "date", "subject", "msgid", "package",
  52                 "keywords", "done", "forwarded", "mergedwith", "severity" );
  53     my $i = 0;
  54     my $tag;
  55
  56     print "D2: (DBase) Record Fields:\n" if $Globals{ 'debug' } > 1;
  57     foreach my $line ( @data )
  58     {
  59         chop( $line );
  60         $tag = $fields[$i];
  61         $Record{ $tag } = $line;
  62         print "\t $tag = $line\n" if $Globals{ 'debug' } > 1;
  63         $i++;
  64         $BTags{ "BUG_$tag" } = $line;
  65     }
  66 }
  67
  68 sub ParseVersion2Record
  69 {
  70     # I envision the next round of records being totally different in
  71     # meaning.  In order to maintain compatability, version tagging will be
  72     # implemented in thenext go around and different versions will be sent
  73     # off to different functions to be parsed and interpreted into a format
  74     # that the rest of the system will understand.  All data will be saved
  75     # in whatever 'new" format ixists.  The difference will be a "Version: x"
  76     # at the top of the file.
  77
  78     print "No version 2 records are understood at this time\n";
  79     exit 1;
  80 }
  81
  82 sub ReadRecord
  83 {
  84     my $record = $_[0];
  85     print "V: Reading status $record\n" if $Globals{ 'verbose' };
  86     if ( $record ne $LoadedRecord )
  87     {
  88         my @data;
  89
  90         seek( $FileHandle, 0, 0 );
  91         @data = <$FileHandle>;
  92         if ( scalar( @data ) =~ /Version: (\d*)/ )
  93         {
  94             if ( $1 == 2 )
  95             { &ParseVersion2Record( @data ); }
  96             else
  97             { &fail( "Unknown record version: $1\n"); }
  98         }
  99         else { &ParseVersion1Record( @data ); }
 100         $LoadedRecord = $record;
 101     }
 102     else { print "D1: (DBase) $record is already loaded\n" if $Globals{ 'debug' }; }
 103
 104 }
 105
 106 sub WriteRecord
 107 {
 108     my @fields = ( "originator", "date", "subject", "msgid", "package",
 109                 "keywords", "done", "forwarded", "mergedwith", "severity" );
 110     print "V: Writing status $LoadedRecord\n" if $Globals{ 'verbose' };
 111     seek( $FileHandle, 0, 0 );
 112     for( my $i = 0; $i < $#fields; $i++ )
 113     {
 114         if ( defined( $fields[$i] ) )
 115         { print $FileHandle $Record{ $fields[$i] } . "\n"; }
 116         else { print $FileHandle "\n"; }
 117     }
 118 }
 119
 120 sub GetFileName
 121 {
 122     my ($prePaths, $stub, $postPath, $desc, $new) = (shift, shift, shift, shift, shift);
 123     my $path;
 124     foreach my $prePath (@$prePaths) {
 125         $path = "/" . $prePath . "/" . $stub . $postPath;
 126         print "V: Opening $desc $stub\n" if $Globals{ 'verbose' };
 127         print "D2: (DBase) trying $path\n" if $Globals{ 'debug' } > 1;
 128         if( ! -r $Globals{ "work-dir" } . $path ) {
 129             $path = "/" . $prePath . "/" . &NameToPathHash($stub) . $postPath;
 130             print "D2: (DBase) trying $path\n" if $Globals{ 'debug' } > 1;
 131             if( ! -r $Globals{ "work-dir" } . $path ) {
 132                 next if( !$new =~ "new" );
 133             }
 134         }
 135         if( -r $Globals{ "work-dir" } . $path ) {
 136             return $path;
 137         }
 138         if( ( ! -r $Globals{ "work-dir" } . $path ) && defined($new) && $new =~ "new") {
 139             my $dir = dirname( $path );
 140             if ( ! -d $Globals{ "work-dir" } . $dir ) {
 141                 mkpath($Globals{ "work-dir" } . $dir);
 142             }
 143             return $path;
 144         }
 145     }
 146     return undef;
 147 }
 148 sub OpenFile
 149 {
 150     my ($prePaths, $stub, $postPath, $desc, $new) = (shift, shift, shift, shift, shift);
 151     my $fileName = GetFileName($prePaths, $stub, $postPath, $desc, $new);
 152     my $handle = new FileHandle;
 153     open( $handle, $Globals{ "work-dir" } . $fileName ) && return $handle;
 154     return undef;
 155 }
 156
 157 sub OpenRecord
 158 {
 159     my $record = $_[0];
 160     if ( $record ne $OpenedRecord )
 161     {
 162         $FileHandle = OpenFile ["db", "archive"], $record, ".status", "status", $_[1];
 163         flock( $FileHandle, LOCK_EX ) || &fail( "Unable to lock record $record\n" );
 164         $OpenedRecord = $record;
 165     }
 166 }
 167
 168 sub CloseRecord
 169 {
 170     print "V: Closing status $LoadedRecord\n" if $Globals{ 'verbose' };
 171     close $FileHandle;
 172     $OpenedRecord = 0;
 173 }
 174
 175 sub OpenLogfile
 176 {
 177     my $record = $_[0];
 178     if ( $record ne $OpenedLog )
 179     {
 180         $LogfileHandle = OpenFile(["db", "archive"], $record, ".log", "log");
 181         $OpenedLog = $record;
 182     }
 183 }
 184
 185 sub ReadLogfile
 186 {
 187     my $record = $_[0];
 188     if ( $record eq $OpenedLog )
 189     {
 190         seek( $LogfileHandle, 0, 0 );
 191         my $log = new Debbugs::DBase::Log;
 192         $log->Load($LogfileHandle);
 193     }
 194 }
 195
 196 sub CloseLogfile
 197 {
 198     print "V: Closing log $OpenedLog\n" if $Globals{ 'verbose' };
 199     close $LogfileHandle;
 200     $OpenedLog = 0;
 201 }
 202 sub GetBugList
 203 {
 204 # TODO: This is ugly, but the easiest for me to implement.
 205 #       If you have a better way, then please send a patch.
 206 #
 207     my $dir = new FileHandle;
 208
 209     my $prefix;
 210     my $paths = shift;
 211     my @paths;
 212     if ( !defined($paths) ) {
 213         @paths = ("db");
 214     } else {
 215         @paths = @$paths;
 216     }
 217     my @ret;
 218     my $path;
 219     foreach $path (@paths) {
 220         $prefix = $Globals{ "work-dir" } . "/" . $path . "/";
 221         opendir $dir, $prefix;
 222         my @files = readdir($dir);
 223         closedir $dir;
 224         foreach (grep { /\d*\d\d.status/ } @files) {
 225             next if ( ! -s $prefix . "/" . $_ );
 226             s/.status$//;
 227             push @ret, $_;
 228 #           print "$_ -> $_\n";
 229         }
 230         foreach (grep { /^[s0-9]$/ } @files) {
 231             my $_1 = $_;
 232             opendir $dir, $prefix . $_1;
 233             my @files = grep { /^\d$/ } readdir($dir);
 234             closedir $dir;
 235             foreach (@files) {
 236                 my $_2 = $_;
 237                 opendir $dir, "$prefix$_1/$_2";
 238                 my @files = grep { /^\d$/ } readdir($dir);
 239                 close $dir;
 240                 foreach (@files) {
 241                     my $_3 = $_;
 242                     opendir $dir, "$prefix$_1/$_2/$_3";
 243                     my @files = grep { /\d*\d\d.status/ } readdir($dir);
 244                     close $dir;
 245                     foreach (@files) {
 246                         next if ( ! -s "$prefix$_1/$_2/$_3/$_" );
 247                         s/.status$//;
 248                         push @ret, $_;
 249 #                       print "$_ -> $_1/$_2/$_3/$_\n";
 250                     }
 251                 }
 252             }
 253         }
 254     }
 255     return @ret;
 256 }
 257
 258 1;
 259
 260 END { }       # module clean-up code here (global destructor)