#!perl -w
#
# Notes application
#
# Initial Settings
#
use vars qw($s);
$s = do("config.pl");
$s->set('-htmlstart')->{-title} =$s->server_name() .' - Notes';
#
# Form Description
#
$s->tmsql->set(-opflg =>'a') if !$s->uguest; #'<a!v'
$s->tmsql->set(
-form =>[
  {-tbl=>'cgibus.notes', -alias=>'notes'}
 ,{-flg=>'vqiskw"',-fld=>'id', -lbl=>'ID', -cmt=>'Unique identifier of the Note'
        ,-crt=>'New', -cdbi=>sub{$_[0]->user .'/' .$_[0]->strtime('yyyymmddhhmmss')}
        ,-lblhtml=>sub{
          $_[0]->htmlself({-title=>'Open records list'},-lst=>,$_[0]->pxsw('LIST'),'AllActual','$_')
         .($_[0]->cmdg('-qry') ||$_[0]->param('idrm_b') ||$_[0]->param('idrm') ?''
          :$_[0]->submit(-name=>'idrm_b',-value=>'...',-title=>'Show record relations fields'))
         } 
        ,-inphtml=>'<font size=-1>$_</font>'
        }
 ,''
 ,{-flg=>'vqis"',  -fld=>'cuser'
        ,-lbl=>'Creator', -cmt=>'Who was created the Note'
        ,-crt=>sub{$_[0]->user}, -ins=>sub{$_[0]->user}}
 ,''
 ,{-flg=>'vqis"',  -fld=>'ctime'
        ,-lbl=>'Created', -cmt=>'When was created the Note'
        ,-crt=>sub{$_[0]->strtime}, -ins=>sub{$_[0]->strtime}
        ,-clst=>sub{"<FONT SIZE=-1>$_</FONT>"}
        ,-lblhtml=>'',-inphtml=>'<nobr>$_</nobr>'
        }
 ,{-flg=>'vqis"',  -fld=>'idnv'
        ,-lbl=>'NewVer', -cmt=>'Pointer to new version of the Note'
        ,-null=>'', -hide=>sub{!$_}
        ,-lblhtml=>sub{$_[0]->htmlself({-title=>'Open new version of this record'},-sel=>'id'=>$_,'$_')}
        ,-inphtml=>'<font size=-1>$_</font>'
        }
 ,''
 ,{-flg=>'avqiuw"',-fld=>'uuser'
        ,-lbl=>'Updator', -cmt=>'Who was updated the Note'
        ,-crt=>'', -sav=>sub{$_[0]->user}}
 ,''
 ,{-flg=>'avqiu"',-fld=>'utime'
        ,-lbl=>'Updated', -cmt=>'When was updated the Note'
        ,-crt=>'', -sav=>sub{$_[0]->strtime}
        ,-clst=>sub{"<FONT SIZE=-1>$_</FONT>"}
        ,-lblhtml=>'',-inphtml=>'<nobr>$_</nobr>'
        }
 ,{-flg=>'a"',     -fld=>'idrm'
        ,-lbl=>'MainRec', -cmt=>'Note above this in hierarchy'
        ,-hidel=>sub{!$_ && !$_[0]->param('idrm_b')}
        ,-null=>'', -crt=>sub{$_[0]->qparampv('id')}, -inp=>{-maxlength=>60}
        ,-lblhtml=>sub{$_[0]->htmlself({-title=>'Main note'},-sel=>'id'=>$_,'$_')}
        ,-inphtml=>'<font size=-1>$_</font>'
        }
 ,{-flg=>'am"', -fld=>'status'
        ,-lbl=>'Status', -cmt=>'Status of the Note'
        ,-crt=>'ok', -qry=>''
        ,-inp=>{-values=>[qw(ok edit deleted), '']}
        ,-clst=>sub{$_ =~/^(edit|deleted)/ ? "<B><FONT COLOR=\"red\">$_</FONT></B>" : $_}}
 ,''
 ,{-flg=>'a"',     -fld=>'prole'
        ,-lbl=>'PRole', -cmt=>'Principal Role, Group of Principals'
        ,-crt=>sub{
             return($_) if $_ ||($_ =$_[0]->udata->param('urole'));
             foreach my $u (@{$_[0]->ugroups}) {return $u if $u =~/^[o]/};
             foreach my $u (@{$_[0]->ugroups}) {return $u if $u =~/^[g]/};
             $_[0]->param('cuser')
          }
        ,-null=>'', -inp=>{-maxlength=>60}
        ,-lblhtml=>sub{$_[0]->htmlself({-title=>'Open Users'},-lst=>,$_[0]->pxsw('LIST'),'Users','$_')}
        ,-inphtml=>sub{'$_' .$_[0]->htmlddlb('auser_',sub{$_[0]->uglist({})}, qw(prole rrole))}
        }
 ,''
 ,{-flg=>'a"',  -fld=>'rrole'
        ,-lbl=>'Reader', -cmt=>'Reader Role, Group of Readers of the Note'
        ,-crt=>sub{$_}, -null=>'', -inp=>{-maxlength=>60}
        }
 ,{-flg=>'am"', -fld=>'subject'
        ,-lbl=>'Subject', -cmt=>'Subject or Title followed by optional |URL or |_blank|URL'
        ,-crt=>sub{$_}
        ,-inp=>{-asize=>89, -maxlength=>255}, -colspan=>10
        ,-lblhtml=>sub{$_ && /^([^\|]+)\s*\|\s*(_blank|)[\s|]*(\w{3,5}:\/\/.+)/ ? $_[0]->a({-href=>$3,-target=>$2,-title=>'Open URL'},'$_') : '$_'}
        ,-clst=>sub{$_ && /^([^\|]+)\s*\|\s*(_blank|)[\s|]*(\w{3,5}:\/\/.+)/ ? $_[0]->a({-href=>$3,-target=>$2},$_[0]->htmlescape($1)) : $_[0]->htmlescape($_)}
        }
 ,{-flg=>'a"',  -fld=>'comment'
        ,-lbl=>'Comment', -cmt=>'Comment text'
        ,-crt=>sub{$_}, -null=>''
        ,-inp=>{-cols=>68,-maxlength=>4*1024,-arows=>3,-hrefs=>1,-htmlopt=>1}
        ,-colspan=>10}
 ]);
#
# Lists (views) Description
#
$s->tmsql->set(
-lists =>{
  'AllVersions'=> {-lbl=>'All Versions', -cmt=>'All notes available, including old versions and deleted'
                  ,-fields=>[qw(utime idnv status subject)]
                  ,-orderby=>'utime desc, ctime desc'}
 ,'AllActual'=>   {-lbl=>,'All Actual', -cmt=>'All actual notes available'
                  ,-fields=>[qw(utime status subject)]
                  ,-orderby=>'utime desc, ctime desc'
                  ,-where=>"status !='deleted' AND notes.idnv is NULL"}

 ,'AllHier'=>     {-lbl=>,'All Hierarchical', -cmt=>'Hierarchy of all actual notes available'
                  ,-fields=>[qw(status subject)]
                  ,-orderby=>'subject asc'
                  ,-where=>"status !='deleted' AND notes.idnv is NULL AND notes.idrm is NULL"}
 ,'OurActual'=>   {-lbl=>'Our Actual', -cmt=>('Notes ' .$s->user .' involved in')
                  ,-fields=>[qw(utime status subject)]
                  ,-orderby=>'utime desc, ctime desc'
                  ,-filter=>sub{"status !='deleted' AND notes.idnv is NULL"
                   .$_[0]->aclsel('-','-and',qw(prole),$_[0]->unames,qw(cuser uuser))
                   }}
 ,'OurReadings'=> {-lbl=>'Our Readings', -cmt=>('Notes to read by ' .$s->user)
                  ,-fields=>[qw(utime status subject)]
                  ,-orderby=>'utime desc, ctime desc'
                  ,-filter=>sub{"status !='deleted' AND notes.idnv is NULL"
                   .$_[0]->aclsel('-','-and',qw(rrole))
                   }}
 ,'OurHier'=>     {-lbl=>'Our Hierarchical', -cmt=>('Hierarchy of notes ' .$s->user .' involved in')
                  ,-fields=>[qw(status subject)]
                  ,-orderby=>'subject asc'
                  ,-filter=>sub{"status !='deleted' AND notes.idnv is NULL AND notes.idrm is NULL"
                   .$_[0]->aclsel('-','-and',qw(prole),$_[0]->unames,qw(cuser uuser))
                   }}
 ,'PersActual'=>  {-lbl=>'Pers Actual', -cmt=>('Personally ' .$s->user .' notes')
                  ,-fields=>[qw(utime status subject)]
                  ,-orderby=>'utime desc, ctime desc'
                  ,-filter=>sub{"status !='deleted' AND notes.idnv is NULL"
                    .$_[0]->aclsel('-','-and',$_[0]->unames,qw(cuser uuser prole))
                   }}
 ,'PersHier_'=>   {-lbl=>'Pers Hierarchical_', -cmt=>('Hierarchy of personally ' .$s->user .' notes')
                  ,-fields=>[qw(status subject)]
                  ,-orderby=>'subject asc'
                  ,-filter=>sub{"status !='deleted' AND notes.idnv is NULL AND notes.idrm is NULL"
                    .$_[0]->aclsel('-','-and',$_[0]->unames,qw(cuser uuser prole))
                   }}
 ,'Users'=>       {-lbl=>'List Users', -cmt=>'List of users of notes'
                  ,-fields=>[qw(user)], -key=>[$s->tmsql->pxsw('WHERE')]
                  ,-href=>[undef,undef,'-lst',$s->tmsql->pxsw('LIST'),'AllActual']
                  ,-dsub=>sub{my $s =$_[0]; my %uh;
                     my @fl =qw(cuser uuser prole rrole);
                     foreach my $f (@fl){
                       my $sql ="SELECT notes.$f AS $f FROM cgibus.notes AS notes GROUP BY $f ORDER BY $f asc";
                       $s->pushmsg($sql);
                       foreach my $r (@{$s->dbi->selectcol_arrayref($sql)}) {
                          $uh{$r} =1 if $r;
                       }
                     }
                     [map {[$_, $s->dbi->quote($_) .' IN('
                              . join(',',map {'notes.'.$_} @fl) .')']}
                          sort keys %uh]
                   }
                  }
 });
#
# Version Store Description
#
$s->tmsql->set(
-vsd =>{
  -npf=>'idnv'     # new version pointer field
 ,-sf =>'status'   # status field
 ,-svd=>'edit'     # status, where record versioning disable
 ,-sd =>'deleted'  # status, where record is logically deleted
 ,-uuf=>'uuser'    # updator user field
 ,-utf=>'utime'    # update  time field
 });
#
#  File Store Description 
#
$s->tmsql->set(
-fsd => {
  -path  =>$s->fpath('notes/act') # actual records path
 ,-vspath=>$s->fpath('notes/ver') # old versions path
 ,-urf   =>$s->furf ('notes/act') # actual records base filesystem URL (for MSIE)
 ,-url   =>$s->furl ('notes/act') # actual records base URL (for all browsers)
 ,-vsurf =>$s->furf ('notes/ver') # old versions base filesystem URL
 ,-vsurl =>$s->furl ('notes/ver') # old versions base URL
 ,-ksplit=>sub{                   # key to dir split sub
           my @v;
           while ($_ =~/([\\\/])/) {$_ =$'; push @v, $` .$1}
           push @v,substr($_,0,4),substr($_,4,2),substr($_,6,2)
                  ,substr($_,8,2),substr($_,10) if @v;
           return @v
           }
 });
#
# Access Control Description
#
$s->tmsql->set(
-acd=>{
  -swrite=>['Administrators']   # system writers
 ,-sread =>['Administrators']   # system readers
 ,-write =>[qw(prole uuser cuser)]       # writer fields
 ,-read  =>[qw(prole uuser cuser rrole)] # reader fields
 });
#
# Filter Description
#
$s->tmsql->set(-fltlst =>sub{$_[0]->aclsel('-',qw(prole rrole),$_[0]->unames,qw(cuser uuser))});
$s->tmsql->set(-ftext  =>'(notes.subject LIKE %$_ OR notes.comment LIKE %$_)');
#
#
#
$s->tmsql->set(-cmdfrm =>sub{  # view related records in record form
    my $s =shift;
    $s->cmdfrm(@_);
    if ($s->cmd('-sel')) {
       $s->print->hr;
       $s->cmdlst('-gxm!q','AllActual'
         ,'notes.idrm=' .$s->dbi->quote($s->qparam('id')))
    }
});
#
#
# Run Application
#
$s->tmsql->evaluate;


