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