389 lines
8.7 KiB
Perl
389 lines
8.7 KiB
Perl
package TTXInventory;
|
|
#
|
|
# This module is a part of Trouble Ticket Express package
|
|
# http://www.troubleticketexpress.com
|
|
#
|
|
# COPYRIGHT: 2006, United Web Coders
|
|
# http://www.unitedwebcoders.com
|
|
#
|
|
# $Revision: 257 $
|
|
# $Date: 2006-08-16 05:47:08 -0400 (Wed, 16 Aug 2006) $
|
|
#
|
|
|
|
$TTXInventory::VERSION='2.22';
|
|
BEGIN {
|
|
$TTXInventory::REVISION = '$Revision: 257 $';
|
|
if ($TTXInventory::REVISION =~ /(\d+)/) {
|
|
$TTXInventory::REVISION = $1;
|
|
}
|
|
};
|
|
|
|
use strict;
|
|
use TTXData;
|
|
|
|
my $idb = undef;
|
|
my $states = undef;
|
|
my $lasterror;
|
|
my @itemfields = ('id', 'title', 'status', 'img');
|
|
my @statefields = ('id', 'title', 'img');
|
|
|
|
# ====================================================================== notesfn
|
|
|
|
sub notesfn {
|
|
my $cfg = TTXData::get('CONFIG');
|
|
my $dn = $cfg->get('basedir').'/inventory';
|
|
return "$dn/$_[0].cgi";
|
|
}
|
|
|
|
# ======================================================================== idbfn
|
|
|
|
sub idbfn {
|
|
my $cfg = TTXData::get('CONFIG');
|
|
my $dn = $cfg->get('basedir').'/inventory';
|
|
my $fn = "$dn/index.cgi";
|
|
if (! -d $dn) {
|
|
if (!mkdir($dn, 0777)) {
|
|
$lasterror = "Failed to create inventory database directory";
|
|
return undef;
|
|
}
|
|
}
|
|
if (! -f $fn) {
|
|
open(IDB, ">$fn");
|
|
close(IDB);
|
|
if (! -f $fn) {
|
|
$lasterror = "Failed to create inventory database";
|
|
return undef;
|
|
}
|
|
}
|
|
return $fn;
|
|
}
|
|
# ==================================================================== line2item
|
|
|
|
sub line2item {
|
|
chomp($_[0]);
|
|
my @fields = split(/\|/, $_[0]);
|
|
my %item;
|
|
foreach my $key (@itemfields) {
|
|
$item{$key} = shift @fields;
|
|
$item{key} =~ s/^\s+//;
|
|
$item{key} =~ s/\s+$//;
|
|
}
|
|
return %item;
|
|
}
|
|
# ==================================================================== item2line
|
|
|
|
sub item2line {
|
|
my $item = $_[0];
|
|
my @vals;
|
|
foreach my $key (@itemfields) {
|
|
my $val = $item->{$key};
|
|
$val =~ s/\|/!/g;
|
|
push @vals, $val;
|
|
}
|
|
return join('|', @vals);
|
|
}
|
|
# ========================================================================= load
|
|
|
|
sub load {
|
|
if ($idb eq undef) {
|
|
my $fn = idbfn();
|
|
return 0 if $fn eq undef;
|
|
lockdb();
|
|
if (!open(IDB, $fn)) {
|
|
$lasterror = "Failed to open inventory database file";
|
|
return 0;
|
|
}
|
|
flock(IDB,2);
|
|
for (my $line = <IDB>; $line ne undef; $line = <IDB>) {
|
|
my %item = line2item($line);
|
|
next if $item{id} !~ /^\d+$/;
|
|
my $nfn = notesfn($item{id});
|
|
if (-f $nfn) {
|
|
if (open(NOTES, $nfn)) {
|
|
$item{notes} = join('', <NOTES>);
|
|
close(NOTES);
|
|
}
|
|
}
|
|
$idb->{$item{id}} = \%item;
|
|
}
|
|
close(IDB);
|
|
unlockdb();
|
|
}
|
|
return 1;
|
|
}
|
|
# ========================================================================= list
|
|
|
|
sub list {
|
|
return keys %{$idb} if load();
|
|
my @empty;
|
|
return @empty;
|
|
}
|
|
# ====================================================================== getitem
|
|
|
|
sub getitem {
|
|
return undef if !load();
|
|
if (! exists $idb->{$_[0]}) {
|
|
$lasterror = "Item $_[0] does not exist";
|
|
return undef;
|
|
}
|
|
return $idb->{$_[0]};
|
|
}
|
|
# ======================================================================= savedb
|
|
|
|
sub savedb {
|
|
return 1 if $idb eq undef;
|
|
my $fn = idbfn();
|
|
return 0 if $fn eq undef;
|
|
return 0 if !lockdb();
|
|
if (!open(IDB, ">$fn")) {
|
|
$lasterror = "Failed to open inventory database file";
|
|
unlockdb();
|
|
return 0;
|
|
}
|
|
flock(IDB,2);
|
|
foreach my $id (sort {$a <=> $b} keys %{$idb}) {
|
|
next if $id !~ /^\d+$/;
|
|
print IDB item2line($idb->{$id})."\n";
|
|
my $nfn = notesfn($id);
|
|
if ($idb->{$id}->{notes} ne undef) {
|
|
if (open(NOTES, ">$nfn")) {
|
|
print NOTES $idb->{$id}->{notes};
|
|
close(NOTES);
|
|
}
|
|
} elsif (-f $nfn) {
|
|
unlink $nfn;
|
|
}
|
|
}
|
|
close(IDB);
|
|
unlockdb();
|
|
if (TTXData::get('_USECACHE')) {
|
|
eval "use TTXCache";
|
|
TTXCache::purge() if $@ eq undef;
|
|
}
|
|
return 1;
|
|
}
|
|
# ========================================================================== add
|
|
|
|
sub add {
|
|
my $item = $_[0];
|
|
my $fn = idbfn();
|
|
return undef if $fn eq undef;
|
|
return undef if !lockdb();
|
|
if (!load()) {
|
|
unlockdb();
|
|
return undef;
|
|
}
|
|
my @lst = sort {$a <=> $b } list();
|
|
my $cnt = int(@lst);
|
|
if (!$cnt) {
|
|
$item->{id} = 1;
|
|
} else {
|
|
$item->{id} = int($lst[$cnt - 1]) + 1;
|
|
}
|
|
if (!open(IDB, ">>$fn")) {
|
|
$lasterror = "Failed to open inventory database file";
|
|
unlockdb();
|
|
return undef;
|
|
}
|
|
flock(IDB,2);
|
|
seek(IDB,0,2);
|
|
print IDB item2line($item)."\n";
|
|
close(IDB);
|
|
if ($item->{notes} ne undef) {
|
|
my $nfn = notesfn($item->{id});
|
|
if (open(NOTES, ">$nfn")) {
|
|
print NOTES $item->{notes};
|
|
close(NOTES);
|
|
}
|
|
}
|
|
unlockdb();
|
|
if (TTXData::get('_USECACHE')) {
|
|
eval "use TTXCache";
|
|
TTXCache::purge() if $@ eq undef;
|
|
}
|
|
$idb->{$item->{id}} = $item;
|
|
return $item->{id};
|
|
}
|
|
# ======================================================================= lockdb
|
|
my $_lockcnt = 0;
|
|
|
|
sub lockdb {
|
|
if ($_lockcnt) {
|
|
++$_lockcnt;
|
|
return 1;
|
|
}
|
|
my $lockfile = TTXData::get('CONFIG')->get('basedir')."/lockidb.ttx";
|
|
if (! -f $lockfile) {
|
|
if (!open(LOCK, ">$lockfile")) {
|
|
$lasterror = 'LOCKWRERR';
|
|
return 0;
|
|
}
|
|
} elsif (!open(LOCK,"+<$lockfile")) {
|
|
$lasterror = 'LOCKOPNERR';
|
|
return 0;
|
|
}
|
|
flock(LOCK, 2);
|
|
$_lockcnt = 1;
|
|
return 1;
|
|
}
|
|
# ===================================================================== unlockdb
|
|
|
|
sub unlockdb {
|
|
return if !$_lockcnt;
|
|
--$_lockcnt;
|
|
if (!$_lockcnt) {
|
|
flock(LOCK, 8);
|
|
close LOCK;
|
|
}
|
|
}
|
|
# ========================================================================== del
|
|
|
|
sub del {
|
|
my $id = $_[0];
|
|
return 0 if !lockdb();
|
|
if (!load()) {
|
|
unlockdb();
|
|
return 0;
|
|
}
|
|
if (!exists $idb->{$id}) {
|
|
unlockdb();
|
|
return 1;
|
|
}
|
|
my $nfn = notesfn($id);
|
|
unlink $nfn if -f $nfn;
|
|
delete $idb->{$id};
|
|
my $ccode = 1;
|
|
if ($_lockcnt == 1) {
|
|
$ccode = savedb();
|
|
}
|
|
unlockdb();
|
|
return $ccode;
|
|
}
|
|
# ======================================================================== sdbfn
|
|
|
|
sub sdbfn {
|
|
my $cfg = TTXData::get('CONFIG');
|
|
my $dn = $cfg->get('basedir').'/inventory';
|
|
my $fn = "$dn/states.cgi";
|
|
if (! -d $dn) {
|
|
if (!mkdir($dn, 0777)) {
|
|
$lasterror = "Failed to create inventory database directory";
|
|
return undef;
|
|
}
|
|
}
|
|
if (! -f $fn) {
|
|
open(IDB, ">$fn");
|
|
close(IDB);
|
|
if (! -f $fn) {
|
|
$lasterror = "Failed to create status database";
|
|
return undef;
|
|
}
|
|
}
|
|
return $fn;
|
|
}
|
|
# =================================================================== line2state
|
|
|
|
sub line2state {
|
|
chomp($_[0]);
|
|
my @fields = split(/\|/, $_[0]);
|
|
my %state;
|
|
foreach my $key (@statefields) {
|
|
$state{$key} = shift @fields;
|
|
$state{key} =~ s/^\s+//;
|
|
$state{key} =~ s/\s+$//;
|
|
}
|
|
return %state;
|
|
}
|
|
# =================================================================== state2line
|
|
|
|
sub state2line {
|
|
my $state = $_[0];
|
|
my @vals;
|
|
foreach my $key (@statefields) {
|
|
my $val = $state->{$key};
|
|
$val =~ s/\|/!/g;
|
|
push @vals, $val;
|
|
}
|
|
return join('|', @vals);
|
|
}
|
|
# =================================================================== loadstates
|
|
|
|
sub loadstates {
|
|
if ($states eq undef) {
|
|
$states = {};
|
|
my $fn = sdbfn();
|
|
return undef if $fn eq undef;
|
|
if (!open(SDB, $fn)) {
|
|
$lasterror = "Failed to open status database file";
|
|
return undef;
|
|
}
|
|
flock(SDB,2);
|
|
for (my $line = <SDB>; $line ne undef; $line = <SDB>) {
|
|
my %state = line2state($line);
|
|
next if $state{id} !~ /^\d+$/;
|
|
$states->{$state{id}} = \%state;
|
|
}
|
|
close(SDB);
|
|
}
|
|
return $states;
|
|
}
|
|
# ===================================================================== addstate
|
|
|
|
sub addstate {
|
|
my $state = $_[0];
|
|
my $fn = sdbfn();
|
|
return undef if $fn eq undef;
|
|
return undef if !lockdb();
|
|
if (loadstates() eq undef) {
|
|
unlockdb();
|
|
return undef;
|
|
}
|
|
my @lst = sort {$a <=> $b } keys %{$states};
|
|
my $cnt = int(@lst);
|
|
if (!$cnt) {
|
|
$state->{id} = 1;
|
|
} else {
|
|
$state->{id} = int($lst[$cnt - 1]) + 1;
|
|
}
|
|
if (!open(SDB, ">>$fn")) {
|
|
$lasterror = "Failed to open status database file";
|
|
unlockdb();
|
|
return undef;
|
|
}
|
|
flock(SDB,2);
|
|
seek(SDB,0,2);
|
|
print SDB state2line($state)."\n";
|
|
close(SDB);
|
|
unlockdb();
|
|
$states->{$state->{id}} = $state;
|
|
return $state->{id};
|
|
}
|
|
# =================================================================== savestates
|
|
|
|
sub savestates {
|
|
return 1 if $states eq undef;
|
|
my $fn = sdbfn();
|
|
return 0 if $fn eq undef;
|
|
return 0 if !lockdb();
|
|
if (!open(SDB, ">$fn")) {
|
|
$lasterror = "Failed to open status database file";
|
|
unlockdb();
|
|
return 0;
|
|
}
|
|
flock(SDB,2);
|
|
foreach my $id (sort {$a <=> $b} keys %{$states}) {
|
|
next if $id !~ /^\d+$/;
|
|
print SDB state2line($states->{$id})."\n";
|
|
}
|
|
close(SDB);
|
|
unlockdb();
|
|
return 1;
|
|
}
|
|
# ======================================================================== error
|
|
|
|
sub error {
|
|
return $lasterror;
|
|
}
|
|
1;
|
|
#
|