Генератор
Проектов

Проект appsrvgbd

Файл appsrvgbd.gen:

project appsrvgbd
  /firm="UST"
  /version="01.001"
  /http="http://www.ustech.ru"
  /email="managers@ustech.ru"
  /platforms=(uni64,mgu32)
  /run_scripts=(uni64)
  /ide_prj=(cbl64)

package mytypes1

genbd mygbd1

gcss styles1

dirbin mydirbin1

diralias mydiralias1

wport wport1

httpsrvspec mysrvspec1

gblk hpage1

package srvprc1

httpsrv mysrv1

package jtbl1

gtkappspec gtkappspec1

package gappprc1

gtkapp gtkapp1

Файл mygbd1.genbd:

genbd mygbd1;
  /oper_all

record org : mytypes1.t_org;
record emp : mytypes1.t_emp;

set gbd_org member org(orgnum);/oper=(mem,next)
set org_emp owner org member emp(orgnum,empnum);

Файл mytypes1.package:

package mytypes1

type t_orgnum : long;
type t_orgaddr : char8[110];
type t_orgname : char8[100];
type t_org : struct
( t_orgnum orgnum,
  t_orgname orgname,
  t_orgaddr orgaddr
);
type t_empnum : long;
type t_empaddr : char8[120];
type t_empname1 : char8[60];
type t_empname2 : char8[60];
type t_empname3 : char8[60];
type t_emp : struct
( t_orgnum orgnum,
  t_empnum empnum,
  t_empname1 empname1,
  t_empname2 empname2,
  t_empname3 empname3,
  t_empaddr empaddr
);
type orglst : dqueue
(
  record org
  ( t_org yorg
  );
  set orglst_org member org;
);
  /io_used
  /oper_all
type emplst : dqueue
(
  record emp
  ( t_emp yemp
  );
  set emplst_emp member emp;
);
  /io_used
  /oper_all

Файл styles1.gcss:

gcss styles1

body
{ font-family: Ubuntu,"Bitstream Vera Sans","DejaVu Sans",Tahoma,sans-serif;
  font-size: 14px;
  height: 100%;
}

a
{ color: #000080;
  text-decoration: none;
}

a:hover
{ color: #000080;
  text-decoration: none;
}

p
{ font-size: 14px;
  line-height:1.5;
  width: 100%;
}

table
{ border-collapse: collapse;
  border: 1px solid;
}

th
{ border: 1px solid;
}

td
{ border: 1px solid;
}

Файл mydirbin1.dirbin:

dirbin mydirbin1

file "image3.png"
file "image4.png"

Файл mydiralias1.diralias:

diralias mydiralias1

gcss styles1

file "favicon.png"
file "image1.png"
file "image2.png"

Файл wport1.wport:

wport wport1

webreq main();
  /log=header
webreq db_test();
  /log=header
webreq list_org();
  /log=header
webreq list_emp(mytypes1.t_orgnum orgnum);
  /log=header
jsonreq db_test():();
  /log=header
jsonreq jlist_org():(mytypes1.orglst xorglst);
  /log=header
jsonreq jlist_emp(mytypes1.t_orgnum orgnum):(mytypes1.emplst xemplst);
  /log=header

Файл mydbs1.database:

Файл mysrvspec1.httpsrvspec:

httpsrvspec mysrvspec1:"mysrvspec1"
  /dirbin=mydirbin1

genbd pgbd1:mygbd1

vhost hprt1
  /diralias=mydiralias1
(
  script scrp1
  (
    webport wport1
  )
)

Файл hpage1.gblk:

gblk hpage1

<$blockdecl main(mysrvspec1.s_srv xsrv,string8 err)>
<$blockdecl list_org(mysrvspec1.s_srv xsrv,string8 err)>
<$blockdecl list_emp(mysrvspec1.s_srv xsrv,string8 err,mytypes1.t_orgnum orgnum)>

<$implementation>

<$block header(mysrvspec1.s_srv xsrv)>
  <head>
    <title>Test page</title>
    <meta http-equiv='Content-Type' content='text/html; charset=UTF-8'>
    <meta http-equiv='Pragma' content='no-cache'>
    <meta http-equiv='Cache-Control' content='no-cache'>
    <link rel='stylesheet' type='text/css' href=(xsrv.yhttp_hprt1.alias_mydiralias1,"styles1.css") media='all'/>
    <link rel='icon' type='image/png' href=(xsrv.yhttp_hprt1.alias_mydiralias1,"favicon.png")/>
  </head>
</$block>

<$blockdecl main(mysrvspec1.s_srv xsrv,string8 err)>
  <html>
    <$call header(xsrv)>
    <body>
      <$if ( err <> "" )>
        <p><$text (err)></p>
        <hr>
      </$if>
      <p><a $href=wport1.main()>Main page</a></p>
      <p><a $href=wport1.db_test()>Test database</a></p>
      <p><a $href=wport1.list_org()>DBS Org list</a></p>
      <br>
      <img src=(xsrv.yhttp_hprt1.alias_mydiralias1,"image1.png")>
      <br>
      <img src=(xsrv.yhttp_hprt1.alias_mydiralias1,"image2.png")>
      <br>
      <img src="/image3.png">
      <br>
      <img src="/image4.png">
    </body>
  </html>
</$blockdecl>

<$blockdecl list_org(mysrvspec1.s_srv xsrv,string8 err)>
  <html>
    <$call header(xsrv)>
    <body>
      <$if ( err <> "" )>
        <p><$text (err)></p>
        <hr>
      </$if>
      <p><a $href=wport1.main()>Main page</a></p>
      <$oper
        var
          mygbd1.org rorg,
          mytypes1.t_org yorg;
        mygbd1.gbd_org_mem(xsrv.pgbd1,0,rorg,yorg);
      >
      <table>
        <tr>
          <th>Org name></th>
          <th>Org addr></th>
        </tr>
        <$while ( isnotnull(rorg) )>
          <tr>
            <td><$text (yorg.orgnum)></td>
            <td><a $href=wport1.list_emp(yorg.orgnum)><$text (yorg.orgname)></a></td>
            <td><$text (yorg.orgaddr)></td>
          </tr>
          <$oper
            mygbd1.gbd_org_next(rorg,yorg);
          >
        </$while
        >
      </table>
    </body>
  </html>
</$blockdecl>

<$blockdecl list_emp(mysrvspec1.s_srv xsrv,string8 err,mytypes1.t_orgnum orgnum)>
  <html>
    <$call header(xsrv)>
    <body>
      <$if ( err <> "" )>
        <p><$text (err)></p>
        <hr>
      </$if>
      <p><a $href=wport1.main()>Main page</a></p>
      <p><a $href=wport1.list_org()>GBD Org list</a></p>
      <$oper
        var
          mygbd1.org rorg,
          mygbd1.emp remp,
          mytypes1.t_org yorg,
          mytypes1.t_emp yemp;
        mygbd1.gbd_org_key(xsrv.pgbd1,orgnum,rorg,yorg);
        if ( isnull(rorg) )
          error "ORG not found";
        mygbd1.org_emp_mem(rorg,0,remp,yemp);
      >
      <table>
        <tr>
          <th>Id</th>
          <th>Emp name1></th>
          <th>Emp name2></th>
          <th>Emp name3></th>
          <th>Emp addr></th>
        </tr>
        <$while ( isnotnull(remp) )>
          <tr>
            <td><$text (yemp.empnum)></td>
            <td><$text (yemp.empname1)></td>
            <td><$text (yemp.empname2)></td>
            <td><$text (yemp.empname3)></td>
            <td><$text (yemp.empaddr)></td>
          </tr>
        </$while
          mygbd1.org_emp_next(remp,yemp);
        >
      </table>
    </body>
  </html>
</$blockdecl>

Файл srvprc1.package:

package srvprc1

procdecl main(mysrvspec1.s_srv xsrv,web.t_web xweb);
procdecl db_test(mysrvspec1.s_srv xsrv,web.t_web xweb);
procdecl list_org(mysrvspec1.s_srv xsrv,web.t_web xweb);
procdecl list_emp(mysrvspec1.s_srv xsrv,web.t_web xweb,mytypes1.t_orgnum orgnum);
procdecl jlist_org(mysrvspec1.s_srv xsrv,mytypes1.orglst xorglst);
procdecl jlist_emp(mysrvspec1.s_srv xsrv,mytypes1.t_orgnum orgnum,mytypes1.emplst xemplst);
procdecl srv_default(mysrvspec1.s_srv xsrv,web.t_web xweb);
procdecl srv_error(mysrvspec1.s_srv xsrv,web.t_web xweb,web.t_status status,errfun.t_mess txt);
fprocdecl srv_init(mysrvspec1.s_srv xsrv);
procdecl srv_start(mysrvspec1.s_srv xsrv);

implementation

procdecl main(mysrvspec1.s_srv xsrv,web.t_web xweb)
{ call hpage1.main(xweb,xsrv,"","");
}

procdecl db_test(mysrvspec1.s_srv xsrv,web.t_web xweb)
{ var
    int iorg;

  for ( iorg := 0; iorg < 10; iorg += 1 )
  { var
      mytypes1.t_org yorg,
      mygbd1.org rorg,
      int iemp;

    mygbd1.gbd_org_mem(xsrv.pgbd1,-1,rorg,yorg);
    yorg.orgnum += 1;
    rand_test.firm8(yorg.orgname);
    rand_test.addr8(false,yorg.orgaddr);
    mygbd1.org_cre(xsrv.pgbd1,yorg,rorg);
    mygbd1.gbd_org_con(xsrv.pgbd1,rorg);

    for ( iemp := 0; iemp < 10; iemp += 1 )
    { var
      mytypes1.t_emp yemp,
      mygbd1.emp remp;

      mygbd1.org_emp_mem(rorg,-1,remp,yemp);
      yemp.empnum += 1;
      rand_test.name8(yemp.empname1,yemp.empname2,yemp.empname3);
      rand_test.addr8(true,yemp.empaddr);
      mygbd1.emp_cre(xsrv.pgbd1,yemp,remp);
      mygbd1.org_emp_con(rorg,remp);
    }
  }

  call hpage1.main(xweb,xsrv,"","");
}

procdecl list_org(mysrvspec1.s_srv xsrv,web.t_web xweb)
{ call hpage1.list_org(xweb,xsrv,"","");
}

procdecl list_emp(mysrvspec1.s_srv xsrv,web.t_web xweb,mytypes1.t_orgnum orgnum)
{ call hpage1.list_emp(xweb,xsrv,"",orgnum,"");
}

procdecl jlist_org(mysrvspec1.s_srv xsrv,mytypes1.orglst xorglst)
{ var
    mygbd1.org rorg,
    mytypes1.t_org yorg;

  mygbd1.gbd_org_mem(xsrv.pgbd1,0,rorg,yorg);

  while ( isnotnull(rorg) )
  { var
      mytypes1.org xorg;

    mytypes1.org_cre(xorglst,xorg);
    xorg.yorg := yorg;
    mytypes1.orglst_org_ins(xorglst,xorg,-1);
    mygbd1.gbd_org_next(rorg,yorg);
  }
}

procdecl jlist_emp(mysrvspec1.s_srv xsrv,mytypes1.t_orgnum orgnum,mytypes1.emplst xemplst)
{ var
    mygbd1.org rorg,
    mygbd1.emp remp,
    mytypes1.t_org yorg,
    mytypes1.t_emp yemp;

  mygbd1.gbd_org_key(xsrv.pgbd1,orgnum,rorg,yorg);
  if ( isnull(rorg) )
    error "ORG not found";

  mygbd1.org_emp_mem(rorg,0,remp,yemp);

  while ( isnotnull(remp) )
  { var
      mytypes1.emp xemp;

    mytypes1.emp_cre(xemplst,xemp);
    xemp.yemp := yemp;
    mytypes1.emplst_emp_ins(xemplst,xemp,-1);
    mygbd1.org_emp_next(remp,yemp);
  }
}

procdecl srv_default(mysrvspec1.s_srv xsrv,web.t_web xweb)
{ web.reply_code(xweb,"302 Found\r\n");
  web.header(xweb,"Location: ");
  web.header(xweb,xsrv.yhttp_hprt1.yconf_hprt1_scrp1.script_name);
  web.header(xweb,"?action=main");
  web.header(xweb,"\r\n\r\n");
}

procdecl srv_error(mysrvspec1.s_srv xsrv,web.t_web xweb,web.t_status status,errfun.t_mess txt)
{ referenced(status);
  web.reply_code(xweb,"404 Not Found\r\n");
  web.header(xweb,"Content-Type: text/html\r\n");
  web.header(xweb,"\r\n");
  web.html(xweb,"<html><head>\n");
  web.html(xweb,"<title>404 Not Found</title>\n");
  web.html(xweb,"</head><body>\n");
  web.text8(xweb,"<p>",txt,"</p>");
  web.html(xweb,"<a href='");
  web.html(xweb,xsrv.yhttp_hprt1.yconf_hprt1_scrp1.script_name);
  web.html(xweb,"?action=main");
  web.text8(xweb,"'>","Press here","</a>");
  web.html(xweb,"</body></html>\n");
}

fprocdecl srv_init(mysrvspec1.s_srv xsrv)
{ referenced(xsrv);
}

procdecl srv_start(mysrvspec1.s_srv xsrv)
{ xsrv.yconf.xwebsrv.deb := false;
  xsrv.yhttp_hprt1.xhprt1.docroot := xsrv.dir_mydirbin1;
}

Файл mysrv1.httpsrv:

httpsrv mysrv1 httpsrvspec mysrvspec1
  /regdir="gbd_pgbd1"

init
{ setcallback xsrv.cb_init_fun := srvprc1.srv_init(xsrv);
  setcallback xsrv.cb_start_fun := srvprc1.srv_start(xsrv);
}

vhost hprt1
  /ipaddr="0.0.0.0"
  /port=30001
(
  script scrp1
  (
    webreq main := srvprc1.main(xsrv,xweb);
    webreq db_test := srvprc1.db_test(xsrv,xweb);
    webreq list_org := srvprc1.list_org(xsrv,xweb);
    webreq list_emp := srvprc1.list_emp(xsrv,xweb,orgnum);
    jsonreq db_test := srvprc1.db_test(xsrv,xweb);
    jsonreq jlist_org := srvprc1.jlist_org(xsrv,xorglst);
    jsonreq jlist_emp := srvprc1.jlist_emp(xsrv,orgnum,xemplst);
  )
  default := srvprc1.srv_default(xsrv,cb_xweb);
  error := srvprc1.srv_error(xsrv,cb_xweb,cb_status,cb_txt);
)

Файл jtbl1.package:

package jtbl1

jtable j_orglst(mytypes1.orglst)
(
  table orglst_org org
  (
    org
  )
);

jtable j_emplst(mytypes1.emplst)
(
  table emplst_emp emp
  (
    emp
  )
);

Файл gtkappspec1.gtkappspec:

gtkappspec gtkappspec1:"gtkappspec1"
  /platforms=(uni64)

gtklayout l_main
( textedit tedt
  command cm_exit:"Exit"
  command cm_orglst:"DBS Org list" image org
  command cm_dbtest:"DBS Test"
  command cm_about:"About" image sys_about
  menu m_file:"File"
  (
    menuitem m_cm_exit command cm_exit
  )
  menu m_view:"View"
  (
    menuitem m_cm_orglst command cm_orglst
  )
  menu m_setup:"Setup"
  (
    menuitem m_cm_dbtest command cm_dbtest
  )
  menu m_help:"Help"
  (
    menuitem m_cm_about command cm_about
  )
  toolbar tlb1
    button t_cm_orglst command cm_orglst
    button t_cm_about command cm_about
);

gtklayout l_org
( table org
  command cm_exit:"Exit"
  command cm_main:"To main" image main
  command cm_orglst:"Org list" image org
  command cm_emplst:"Emp list" image emp
  command cm_about:"About" image sys_about
  menu m_file:"File"
  (
    menuitem m_cm_exit command cm_exit
  )
  menu m_view:"View"
  (
    menuitem m_cm_main command cm_main
    menuitem m_cm_orglst command cm_orglst
    menuitem m_cm_emplst command cm_emplst
  )
  menu m_help:"Help"
  (
    menuitem m_cm_about command cm_about
  )
  toolbar tlb1
    button t_cm_main command cm_main
    button t_cm_orglst command cm_orglst
    button t_cm_emplst command cm_emplst
    button t_cm_about command cm_about
  context org
  (
    menuitem m_org_cm_emplst command cm_emplst
  )
);

gtklayout l_emp
( table emp
  command cm_exit:"Exit"
  command cm_main:"To main" image main
  command cm_orglst:"Org list" image org
  command cm_emplst:"Emp list" image emp
  command cm_about:"About" image sys_about
  menu m_file:"File"
  (
    menuitem m_cm_exit command cm_exit
  )
  menu m_view:"View"
  (
    menuitem m_cm_main command cm_main
    menuitem m_cm_orglst command cm_orglst
    menuitem m_cm_emplst command cm_emplst
  )
  menu m_help:"Help"
  (
    menuitem m_cm_about command cm_about
  )
  toolbar tlb1
    button t_cm_main command cm_main
    button t_cm_orglst command cm_orglst
    button t_cm_emplst command cm_emplst
    button t_cm_about command cm_about
);

global
( gcurl.t_curl xcrl,
  webclt.websess xwebsess
)

config
( webclt.t_host host,
  int port,
  webclt.t_salias salias
)

tabpage
( mytypes1.t_orgnum orgnum_cur
)

layout l_main main
(
);

layout l_org org
( mytypes1.orglst xorglst
);

layout l_emp emp
( mytypes1.emplst xemplst
);

jsonclt jcltdb_test wport1.db_test;
  /sess

jsonclt jclt_orglst wport1.jlist_org;
  /sess

jsonclt jclt_emplst wport1.jlist_emp;
  /sess

gtable orglst jtable jtbl1.j_orglst;

gtable emplst jtable jtbl1.j_emplst;

fprocdecl setup_main(topwin xtopwin);
procdecl setup_org(topwin xtopwin,lay_org xlay);
procdecl setup_emp(topwin xtopwin,lay_emp xlay);

implementation

fprocdecl setup_main(topwin xtopwin)
{ gframe.mwin_title(xtopwin.xtwin,"Main window");
}

procdecl setup_org(topwin xtopwin,lay_org xlay)
{ call orglst_org_header(xlay.ylayout.org);
  call orglst_org_table(xlay.ylayout.org,xlay.xorglst);
  gframe.mwin_title(xtopwin.xtwin,"DBS Orgs");
}

procdecl setup_emp(topwin xtopwin,lay_emp xlay)
{ call emplst_emp_header(xlay.ylayout.emp);
  call emplst_emp_table(xlay.ylayout.emp,xlay.xemplst);
  gframe.mwin_title(xtopwin.xtwin,"DBS Emps");
}

Файл gappprc1.package:

package gappprc1

fprocdecl cmd_exit(gtkappspec1.topwin xtopwin);
procdecl cmd_main(gtkappspec1.a_app xapp,gtkappspec1.topwin xtopwin);
procdecl cmd_test(gtkappspec1.a_app xapp);
procdecl cmd_main_orglst(gtkappspec1.a_app xapp,gtkappspec1.topwin xtopwin);
procdecl cmd_org_orglst(gtkappspec1.a_app xapp,gtkappspec1.topwin xtopwin,gtkappspec1.lay_org xlay);
procdecl cmd_org_emplst(gtkappspec1.a_app xapp,gtkappspec1.topwin xtopwin,gtkappspec1.tabpage xtabpage,gtkappspec1.lay_org xlay);
procdecl cmd_emp_emplst(gtkappspec1.a_app xapp,gtkappspec1.topwin xtopwin,gtkappspec1.tabpage xtabpage,gtkappspec1.lay_emp xlay);

implementation

fprocdecl cmd_exit(gtkappspec1.topwin xtopwin)
{ gframe.mwin_exit(xtopwin.xtwin);
}

procdecl cmd_main(gtkappspec1.a_app xapp,gtkappspec1.topwin xtopwin)
{ var
    gtkappspec1.lay_main xlay_main;

  gtkappspec1.lay_main_create(xapp,xtopwin,xlay_main);
  call gtkappspec1.setup_main(xtopwin);
}

procdecl cmd_test(gtkappspec1.a_app xapp)
{ gtkappspec1.jcltdb_test_sess_err(xapp.xcrl,xapp.xwebsess);
}

procdecl cmd_main_orglst(gtkappspec1.a_app xapp,gtkappspec1.topwin xtopwin)
{ var
    gtkappspec1.lay_org xlay_org;

  gtkappspec1.lay_org_create(xapp,xtopwin,xlay_org);
  gtkappspec1.jclt_orglst_sess_err(xapp.xcrl,xapp.xwebsess,xlay_org.xorglst);
  call gtkappspec1.setup_org(xtopwin,xlay_org);
}

procdecl cmd_org_orglst(gtkappspec1.a_app xapp,gtkappspec1.topwin xtopwin,gtkappspec1.lay_org xlay)
{ gtkappspec1.jclt_orglst_sess_err(xapp.xcrl,xapp.xwebsess,xlay.xorglst);
  call gtkappspec1.setup_org(xtopwin,xlay);
}

procdecl cmd_org_emplst(gtkappspec1.a_app xapp,gtkappspec1.topwin xtopwin,gtkappspec1.tabpage xtabpage,gtkappspec1.lay_org xlay)
{ var
    mytypes1.org xorg,
    gtkappspec1.lay_emp xlay_emp;

  call gtkappspec1.orglst_org_current(xlay.xorglst,xlay.ylayout.org,xorg);
  if ( isnull(xorg) )
    error "Select exactly one org";

  xtabpage.orgnum_cur := xorg.yorg.orgnum;
  gtkappspec1.lay_emp_create(xapp,xtopwin,xlay_emp);
  gtkappspec1.jclt_emplst_sess_err(xapp.xcrl,xapp.xwebsess,xtabpage.orgnum_cur,xlay_emp.xemplst);
  call gtkappspec1.setup_emp(xtopwin,xlay_emp);
}

procdecl cmd_emp_emplst(gtkappspec1.a_app xapp,gtkappspec1.topwin xtopwin,gtkappspec1.tabpage xtabpage,gtkappspec1.lay_emp xlay)
{ gtkappspec1.jclt_emplst_sess_err(xapp.xcrl,xapp.xwebsess,xtabpage.orgnum_cur,xlay.xemplst);
  call gtkappspec1.setup_emp(xtopwin,xlay);
}

Файл gtkapp1.gtkapp:

gtkapp gtkapp1 gtkappspec gtkappspec1

gabout about gtkappspec1;

proc cmd_about(gtkappspec1.topwin xtopwin)
{ call dlg_about(xtopwin.xtwin);
}

fproc init_fun(gtkappspec1.a_app xapp)
{ referenced(xapp);
}

proc start_fun(gtkappspec1.a_app xapp)
{ webclt.websess_empty(xapp.xwebsess);
  xapp.xwebsess.ywebclt.host := xapp.host;
  xapp.xwebsess.ywebclt.port := xapp.port;
  xapp.xwebsess.ywebclt.salias := xapp.salias;
  gcurl.open(xapp.xcrl);
}

init
{ xapp.host := "127.0.0.1";
  xapp.port := 30001;
  xapp.salias := "/hprt1/scrp1";
  setcallback xapp.cb_init_fun := init_fun(xapp);
  setcallback xapp.cb_start_fun := start_fun(xapp);
}

control main
(
  cm_exit := gappprc1.cmd_exit(xtopwin);
  cm_about := cmd_about(xtopwin);
  cm_dbtest := gappprc1.cmd_test(xapp);
  cm_orglst := gappprc1.cmd_main_orglst(xapp,xtopwin);
)

control org
(
  cm_exit := gappprc1.cmd_exit(xtopwin);
  cm_main := gappprc1.cmd_main(xapp,xtopwin);
  cm_about := cmd_about(xtopwin);
  cm_orglst := gappprc1.cmd_org_orglst(xapp,xtopwin,xlay);
  cm_emplst := gappprc1.cmd_org_emplst(xapp,xtopwin,xtabpage,xlay);
)

control emp
(
  cm_exit := gappprc1.cmd_exit(xtopwin);
  cm_main := gappprc1.cmd_main(xapp,xtopwin);
  cm_about := cmd_about(xtopwin);
  cm_orglst := gappprc1.cmd_main_orglst(xapp,xtopwin);
  cm_emplst := gappprc1.cmd_emp_emplst(xapp,xtopwin,xtabpage,xlay);
)
Скачать проект appsrvgbd