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