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