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