#!/usr/bin/perl -w
#
# example for DBIx::FileSystem
#
# pawactl   : packet warehouse control program
#
# Last Update:		$Author: marvin $
# Update Date:		$Date: 2003/04/09 11:07:10 $
# Source File:		$Source: /home/cvsroot/tools/FileSystem/pawactl,v $
# CVS/RCS Revision:	$Revision: 1.1.1.1 $
# Status:		$State: Exp $
# 
# Imagine a warehouse for packet distribution: Some well known senders are
# allowed to send packets to the warehouse. There are well known destinations
# where the packets will be delivered to. A warehouse process is responsible
# for the packet flow within the warehouse:
#
#   - When a new packet comes in, the warehouse process first checks if 
#     the sender is allowed to send packets
#   - If the packet is Ok the warehouse process will put it into the warehouse
#   - When the final receiver is ready the warehouse process will deliver the
#     packet from the warehouse to the final destination. The warehouse
#     process will read the destination from the config (table 'source')
#
# All the config for the warehouse process will be put into the database given
# below as well as the warehouse itself. The warehouse will be under complete 
# control of the warehouse process, the config data will only be read by 
# the warehouse process.
#
# The warehouse process itself is implemented elsewhere, pawactl 
# is only for configuration editing and database creation.
# When called with parameter 'recreatedb' set, pawactl will also generate some
# dummy entries in the warehouse and some config entries to play around with.
#
# Things to look at:
#  - directory 'dest':
#     - mars moon and neptun cannot be removed because they are referenced
#     - sun cannot be removed because it is protected by &myrmcheck function
#     - All variables have type and length check when saving the file with vi
#     - The 'Delay' variable additionally has a custom range check function
#     - The 'MaxPacketSize' variable must not be NULL because of the 
#       database constraint 'NOT NULL'. Note the errormessage when saving a
#       file with MaxPacketSize = empty comes from the database.
#  - directory 'source':
#     - commands sum,cat,vi take care of the default file 'generic'
#     - file generic can not be removed because it is the defaultfile
#     - variable 'SourceID' will be set to NULL when copying a file (delcp)
#     - variable 'Distance' must be set because of a custom value check 
#       function &mydefcheck. Note the errormessage is much more descriptive
#       (incl. line number) when saving a file where Distance is not set.
#       Compare this with 'MaxPacketSize' in directory 'dest'
#     - variable 'Destination' is a reference to directory dest. Only one 
#       valid filename or an empty value can be entered here.
#  - directory 'warehouse':
#     - this directory is write protected
#     - you can still look into files with sum and cat
#     - variable 'StatusFlag' is of type bool, (not supported when edit=1)
#     - variable 'LastChecked' is of type datetime, (not supported when edit=1)
#
# NOTE: Edit the DB params below
# NOTE: to start pawactl without installation of DBIx::Filesystem do:
#     		perl Makefile.PL
#		make
#		perl -Iblib/lib pawactl
#
# License:
#   You may distribute under the terms of the GNU General Public License.
#
# CVS/RCS Log:
# $Log: pawactl,v $
# Revision 1.1.1.1  2003/04/09 11:07:10  marvin
# Imported Sources
#
#


use DBIx::FileSystem qw( mainloop recreatedb );

# database version string
my $VERSION = "0001";	# our version string

# DBI connect string    EDIT THIS! The database must exist!
my $DBHOST = "dbi:Pg:dbname=warehouse;host=tpau";

# DBI user
my $DBUSER = "marvin";

# DBI password
my $DBPWD = undef;

# the name of the control program
my $PROGNAME = $0;
$PROGNAME =~ s/.*\///;


########################################################################
# v i r t u a l   d i r e c t o r i e s   ( d b   t a b l e s )
########################################################################

my $pos = 0;	# dummy counter for setting up the vdirs hash
my %vdirs = 
  ( 
   # configuration data for the warehouse process
   # A source defines who is allowed to send packets to the warehouse
   source   => 			# dirname (=tablename)
   { desc => "source config",	# description
     edit => 1,			# new/vi/rm allowed ? (no/yes = 0/1)
     fnamcol => 'srcname',	# column which acts as filename, must be of
      				# type 'char' plus for edit=1 len must be set
     defaultfile => 'generic',	# name of a default file (optional)
     cols => 				# columns
     { srcname => 				# columnname in DB
       { type	=> 'char',			# mandatory: DB type
	 len	=> 10,				# mandatory (edit = 1 !)
	 colopt=> 'PRIMARY KEY',		# optional, but useful here
	 var 	=> 'SourceName',		# mandatory, variable name
	 desc	=> "Symbolic name of the source",# mandatory, description
	 pos	=> $pos++,			# mandatory, auto incr position
       },
       srcid => 				# columnname in DB
       { type	=> 'char',
	 len 	=> 4,
	 var	=> 'SourceID',
	 desc	=> "Internal source idenficator (4 characters)",
	 delcp => 1,				# optional: 1: delete when cp
	 pos	=> $pos++,
       },
       dist => 					# columnname in DB
       { type	=> 'int',
	 var	=> 'Distance',
	 valok 	=> \&mydefcheck,		# custom value check function
	 desc	=> "The distance between warehouse and source (integer)",
	 pos	=> $pos++,			
       },
       sendto =>		# now we have a ref, no type or len here
       { ref	=> 'dest',	# valid values come from table REF, col FNAMCOL
	 var	=> 'Destination',
	 desc	=> "The destination where all packets will be send to",
	 pos	=> $pos++,
       },
     }, 
   },

   # configuration data for the warehouse process
   # A destination defines where the packets from the warehouse will be send to
   dest   => 			# dirname (=tablename)
   { desc => "destination def",	# description
     edit => 1,			# new/vi/rm allowed ? (no/yes = 0/1)
     fnamcol => 'dname',	# column which acts as filename, must be of
      				# type 'char' plus for edit=1 len must be set
     rmcheck => \&myrmcheck,	# a custom check function for 'rm' command
     cols => 				# columns
     { dname => 				# columnname in DB
       { type	=> 'char',			# mandatory: DB type
	 len	=> 15,				# mandatory (edit = 1 !)
	 colopt=> 'PRIMARY KEY',		# optional, but useful here
	 var 	=> 'Destination',		# mandatory, variable name
	 desc	=> "The name of the destination",# mandatory, description
	 pos	=> $pos++,			# mandatory, auto incr position
       },
       addr => 					# columnname in DB
       { type	=> 'char',
	 len	=> 20,			
	 var	=> 'Address',
	 desc	=> "The Address of the destination",
	 pos	=> $pos++,			
       },
       delay => 				# columnname in DB
       { type	=> 'smallint',
	 var	=> 'Delay',
	 valok	=> \&myrangecheck,		# custom value check function
	 desc	=> "The delay when sending packets (1..100)",
	 pos	=> $pos++,			
       },
       mps => 					# columnname in DB
       { type	=> 'smallint',
	 colopt	=> 'NOT NULL',			# optional, but useful here
	 var	=> 'MaxPacketSize',
	 desc	=> "The maximum packet size this destination accepts (smallint)",
	 pos	=> $pos++,			
       },
     }, 
   },

   # now a table that is under control by the warehouse process that uses the 
   # configuration given above. Its not editable, but we can still ls,sum,cat
   warehouse   => 		# dirname (=tablename)
   { desc => "warehouse store",	# description
     edit => 0,			# new/vi/rm allowed ? (no/yes = 0/1)
     fnamcol => 'pid',		# column which acts as filename, must be of
      				# type 'char' plus for edit=1 len must be set
     cols => 				# columns
     { pid => 					# columnname in DB
       { type	=> 'char',			# mandatory: DB type char
	 len	=> 6,				# optional  here
	 var 	=> 'PacketID',			# mandatory, variable name
	 desc	=> "The ID of a packet",	# mandatory, description
	 pos	=> $pos++,			# mandatory, auto incr position
       },
       itim => 					# columnname in DB
       { type	=> 'int',
	 var	=> 'InTime',
	 desc	=> "Incoming time (unix time stamp)",
	 pos	=> $pos++,			
       },
       dummy => 				# columnname in DB
       { type	=> 'int',
	 var	=> 'Dummy',
	 desc	=> "just a dummy",
	 pos	=> $pos++,			
       },
       flag => 					# columnname in DB
       { type	=> 'bool',			# bool ok because edit => 0
	 var	=> 'StatusFlag',
	 desc	=> "just a status flag, (Bool)",
	 pos	=> $pos++,			
       },
       lcheck => 				# columnname in DB
       { type	=> 'datetime',			# datetime ok because edit => 0
	 var	=> 'LastChecked',
	 desc	=> "Sytem this packet was last checked",
	 pos	=> $pos++,			
       },
       dest =>			# now we have a ref, no type or len here
       { ref	=> 'dest',	# valid values come from table REF, col FNAMCOL
	 var	=> 'Destination',
	 desc	=> "The destination where all packets will be send to",
	 pos	=> $pos++,
       },

     }, 
   },

  );

########################################################################
# the 'program'
########################################################################

# check if we wan't to recreate the dbtables
if( $#ARGV==0 and $ARGV[0] eq 'recreatedb' ) {
  recreatedb( %vdirs, $PROGNAME, $VERSION, $DBHOST, $DBUSER, $DBPWD );
  fill_with_dummies();
}else{
  mainloop( %vdirs, $PROGNAME, $VERSION, $DBHOST, $DBUSER, $DBPWD );
}

###############################################################
# sample rmcheck: a function to check if a file can be removed
# in:   $vdir:	the directory
#	$vfile	the file to be removed
# return:
#	- A one line error message if the file cannot be removed
#	- undef if the file can be removed
###############################################################
sub myrmcheck {
  my ($vdir, $vfile) = @_;
  if( $vfile eq 'sun' ) {
    return "file '$vfile' rm protected";
  }else{
    return undef;
  }
}

###############################################################
# sample rangecheck: a function to check if a value is in range 1..100
# If $val is defined it was already checked against length, reference 
# and datatype given by column specs.
#
# in:   $val:	the value to be checked
# return:
#	- A one line error message if the value is invalid
#	- undef if the value is ok
###############################################################
sub myrangecheck {
  my ($val) = shift;
  if( defined $val ) {
    # if the value is defined it must be in range 1..100
    if( $val < 1 or $val > 100 ) {
      return "invalid value: valid range: (1..100)";
    }
  }
  return undef;
}

###############################################################
# sample defcheck: a function to check if a value is defined
# in:   $val:	the value to be checked
# return:
#	- A one line error message if the value is not defined
#	- undef if the value is ok
###############################################################
sub mydefcheck {
  my ($val) = shift;
  if( defined $val ) {
    return undef;
  }
  return "value must be set";
}

###############################################################
# sample: fill the warehouse and config with dummies...
###############################################################

use DBI;

# write some dummy data to the tables, so we have something to play around...
sub fill_with_dummies {
  my $dbh;
  my $r;
  my $inssource = "insert into source (srcname,srcid,dist,sendto) values";
  my $insdest = "insert into dest (dname,addr,delay,mps) values";
  my $inswh = "insert into warehouse (pid,itim,dummy,flag,lcheck,dest) values";

  ($dbh = DBI->connect( $DBHOST, $DBUSER, $DBPWD,
     {ChopBlanks => 1, AutoCommit => 1, PrintError => 0})) 
     || die "$PRG: connect to '$DBHOST' failed:\n", $DBI::errstr;

  # set 'generic' default values
  $r=$dbh->do( "update source set srcid='----',dist=-1");

  $dbh->do( "$inssource ('factory1','BBF1',224,'moon')" );
  $dbh->do( "$inssource ('factory2','BBF2',576,'mars')" );
  $dbh->do( "$inssource ('acity','CIA',54565,'mars')" );
  $dbh->do( "$inssource ('bcity','CIB',2434,'moon')" );
  $dbh->do( "$inssource ('kcity','CIK',4455,'moon')" );
  $dbh->do( "$inssource ('fromfar',NULL,1000000,'mars'" );

  $dbh->do( "$insdest ('moon','nearby',77,55)" );
  $dbh->do( "$insdest ('venus','direction sun',12,67)" );
  $dbh->do( "$insdest ('mars','direction galaxy',8,999)" );
  $dbh->do( "$insdest ('neptun','nearby sun',3,2121)" );
  $dbh->do( "$insdest ('sun','the center',7,1)" );

  $dbh->do( "$inswh ('kr3345',123456700,42,true,'2003-03-04','moon')" );
  $dbh->do( "$inswh ('kr7000',123456702,42,true,'2003-03-03','moon')" );
  $dbh->do( "$inswh ('um3345',123456703,42,true,'2003-03-01','moon')" );
  $dbh->do( "$inswh ('um2545',123456704,42,false,'2003-03-01','mars')" );
  $dbh->do( "$inswh ('um4678',123456705,42,true,'2003-03-04','mars')" );
  $dbh->do( "$inswh ('um7766',123456006,42,false,'2003-03-04','mars')" );
  $dbh->do( "$inswh ('um3333',123456707,42,true,'2003-03-04','mars')" );
  $dbh->do( "$inswh ('um5565',123456708,42,false,'2003-01-04','mars')" );
  $dbh->do( "$inswh ('um5545',123456709,42,true,'2003-01-02','mars')" );
  $dbh->do( "$inswh ('sx0001',123456700,42,false,'2003-02-24','mars')" );
  $dbh->do( "$inswh ('sx0002',123456711,42,false,'2003-02-24','moon')" );
  $dbh->do( "$inswh ('sx0034',123456712,42,false,'2003-02-22','moon')" );

  $dbh->disconnect || die "$PRG: Disconnect failed. Reason: ", $DBI::errstr;

  return;
}
