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