The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w
#http://localhost/cgi-bin/web.cgi
BEGIN {
#push @INC, $1 .'sitel/lib' if !(grep /sitel/i, @INC) && ($INC[0] =~/(.+?[\\\/])lib$/i)
}
$ENV{HTTP_ACCEPT_LANGUAGE} ='';
my $wsdir =$^O eq 'MSWin32' ? Win32::GetFullPathName($0) : $0;
   $wsdir =~s/\\/\//g;
   $wsdir =	  $wsdir =~/^(\w:\/inetpub)\//i
		? $1
		: $wsdir =~/\/cgi-bin\//i
		? $`
		: $ENV{DOCUMENT_ROOT} && $ENV{DOCUMENT_ROOT} =~/[\\\/]htdocs/i
		? $`
		: '../';
   $wsdir =	  $wsdir =~/^(\w:\/inetpub)\//i ? "$wsdir/wwwroot" : "$wsdir/htdocs";

use DBIx::Web;
my $w =DBIx::Web->new(
  -title	=>'DBIx-Web'	# title of application
#,-logo		=>''		# logo html/image
 ,-debug	=>2		# debug level
 ,-serial	=>2		# serial operation level
 ,-dbiarg	=>undef
#,-dbiph	=>1		# dbi placeholders usage
#,-dbiACLike	=>'eq lc'	# dbi access control comparation
 ,-keyqn	=>1		# key query null comparation
#,-path		=>"$wsdir/dbix-web"
#,-url		=>'/dbix-web'	# filestore URL
 ,-urf		=>'-path'	# filestore filesystem URL
#,-fswtr	=>''		# filesystem writers (default is process account)
#,-AuthUserFile	=>''		# apache users file
#,-AuthGroupFile=>''		# apache groups file
#,-login	=>/cgi-bin/ntlm/# login URL
#,-userln	=>0		# short local usernames (0 - off, 1 - default)
 ,-ugadd	=>['Everyone','Guests']		# additional user groups
#,-rac		=>0		# record access control (0 - off, 1 - default)
#,-racAdmRdr	=>''		# record access control admin reader
#,-racAdmWtr	=>''		# record access control admin writer
#,-rfa		=>0		# record file attachments (0 - off, 1 - default)
#,-w32xcacls	=>1		# use 'xcacls' instead of 'cacls'
#,-httpheader	=>{}		# http header arguments
#,-htmlstart	=>{}		# html start arguments
	);

my ($r, $c);
$w->set(-table=>{
	'note'=>{
		 -lbl		=>'Notes'
		,-cmt		=>'Notes'
		,-lbl_ru	=>'Çàìåòêè'
		,-cmt_ru	=>'Çàìåòêè'
		,-field		=>[
			 {-fld=>'id'
				,-flg=>'kwq'
				,-lblhtml=>$w->tfoShow('id_',['idrm','idpr'])
				}, ''
			,{-fld=>$w->tn('-rvcActPtr')
				,-flg=>'q'
				,-hidel=>$w->tfoHide('id_')
				}
			,{-fld=>'idrm'
				,-flg=>'euq'
				,-hidel=>$w->tfoHide('id_')
				}, ''
			,{-fld=>'idpr'
				,-flg=>'euq'
				,-hidel=>$w->tfoHide('id_')
				}
			,{-fld=>$w->tn('-rvcInsWhen')
				,-flg=>'q'
				}, ''
			,{-fld=>$w->tn('-rvcInsBy')
				,-flg=>'q'
				}
			,{-fld=>$w->tn('-rvcUpdWhen')
				,-flg=>'wql'
				}, ''
			,{-fld=>$w->tn('-rvcUpdBy')
				,-edit=>0
				,-flg=>'wql'
				}
			,{-fld=>'authors'
			,-flg=>'euq'
			,-ddlb=>sub{$_[0]->uglist({})}
			,-ddlbtgt=>[[undef,undef,','],['readers',undef,',']]
			 	}, ''
			,{-fld=>'readers'
			,-flg=>'euq'
			,-ddlb=>sub{$_[0]->uglist({})}
			,-ddlbtgt=>[[undef,undef,','],['authors',undef,',']]
				 }
			,{-fld=>$w->tn('-rvcState')
			,-inp=>{-values=>$w->tn('-rvcAllState')}
			,-flg=>'euql', -null=>undef
				}
			,{-fld=>'subject'
			,-flg=>'euqlm'
			,-colspan=>4
			,-inp=>{-asize=>60}
			# ,-ddlb=>[[1,'one'],2,3,'qw']	# test
				 }
			,"</table>"
			,{-fld=>'comment'
			,-flg=>'eu'
			,-lblhtml=>'<b>$_</b><br />'
			,-inp=>{-htmlopt=>1, -hrefs=>1, -arows=>5, -cols=>70}
				 }
			,$w->tfsAll()
		]
		,$w->ttoRVC()
		,-racReader	=>[qw(readers)]
		,-racWriter	=>[$w->tn('-rvcUpdBy'), $w->tn('-rvcInsBy'), 'authors']
		,-ridRef	=>[qw(idrm idpr comment)]
		,-rfa		=>1
		,-recNew0R	=>sub{	$_[2]->{'idrm'} =$_[3] && $_[3]->{'id'}||'';
					foreach my $n (qw(authors readers)) {
						$_[2]->{$n} =$_[3]->{$n} 
							if $_[3] && $_[3]->{$n};
						$_[0]->recLast($_[1],$_[2],[$_[0]->tn('-rvcUpdBy')],[$n])
							if !$_[2]->{$n};
					}
					$_[2]->{$_[0]->tn('-rvcState')} ='ok';
					$_[0]
				}
		,-query		=>{-order=>'-dall'
				# ,-frmLso=>['author','hierarchy']
				  }
		,-frmLsoAdd	=>[['hierarchy',undef,{-qkeyadd=>{'idrm'=>undef}}]
				  ]
		,-dbd		=>'dbm'
	}
	,$w->ttsAll()
	});

$w->set(-form=>{
	 'default'	=>{-subst=>'index'}
	,$w->tvdIndex()
	,$w->tvdFTQuery()
	,1 ? ('notehier'	=>{
		 -lbl		=>'Notes hierarchy'
		,-cmt		=>'Notes hierarchy'
		,-lbl_ru	=>'Çàìåòêè èåðàðõè÷åñêè'
		,-cmt_ru	=>'Èåðàðõèÿ çàìåòîê'
		,-table		=>'note'
		,-query		=>{-order=>'-dall'} # -key=>{'idrm'=>undef}
		,-qfilter	=>sub{!$_[4]->{'idrm'}}
		,-frmLsoAdd	=>undef
		}) : ()
	});
$w->set(-index=>1);
$w->set(-setup=>1);
$w->cgiRun();

##############################
# Setup Script
##############################
__END__
#
# Connect as root to mysql, once creating database and user:
#{$_->{-dbi} =undef; $_->{-dbiarg} =['DBI:mysql:mysql','root','password']; $_->dbi; <STDIN>}
#
# Reconnect as operational user, creating or upgrading tables:
#{$_->{-dbi} =undef; $_->{-dbiarg} =$_->{-dbiargpv}; $_->dbi; <STDIN>}
#
# Reindex database:
{$s->recReindex(1)}
#
#