app_gen.ins

genesis 2000 v9.1软件下载

     return "undone"
   }
   set DEST_PATH   [string trim $APP_GEN_G(DEST_PATH)]
   set USERS_PATH  [file join $DEST_PATH share users]
   set GROUPS_PATH [file join $DEST_PATH share groups]
   set PATH_NAMES [list USERS_PATH GROUPS_PATH]

   foreach PATH_NAME $PATH_NAMES {
     set PATH [set $PATH_NAME]
     if [file exists $PATH] {
       if { [file size $PATH] > 0 } {
          tku_popup_message error ok \
             "The file $PATH exists and will not\
            \nbe overridden automatically.\
            \nYou must manually remove it from the database."
          return "error"
       }
     }
   }

   set SHARE_DIR_PATH [file dirname $USERS_PATH]

   if [catch {file mkdir $SHARE_DIR_PATH} RESPONSE] {
      tku_popup_message error ok $RESPONSE
      return "error"
   }

   if { ! [file writable $SHARE_DIR_PATH] } {
      tku_popup_message error ok \
	 [format "Destination directory is not writable\n%s" $SHARE_DIR_PATH]
      return "error"
   }

   if { [winfo exists $W_L] } {
      destroy $W_L
   }
   toplevel $W_L
   wm title $W_L "Users/Groups Entry Window"
   frame $W_F -bg $VPIG(C_BG)
   label $W_FL -bg $VPIG(C_BG) -font [cbr18] \
         -text "请输入:"
	
   frame $W_FU -bg $VPIG(C_BG)
   label $W_FU.l -bg $VPIG(C_BG) -font [cbr14] \
                 -text "用户名: "
   entry $W_FU.e -bg [c_yellow] -font [cbr14] \
         -textvariable APP_GEN_G(SYSADMIN_USER_NAME) -width 15
   pack $W_FU.l $W_FU.e -side left

   frame $W_FP -bg $VPIG(C_BG)
   label $W_FP.l -bg $VPIG(C_BG) -font [cbr14] \
                 -text "密  码: "
   entry $W_FP.e -bg [c_yellow] -font [cbr14] \
         -textvariable APP_GEN_G(SYSADMIN_PASSWORD) -width 15 -show *
   pack $W_FP.l $W_FP.e -side left

   frame $W_FG -bg $VPIG(C_BG)
   label $W_FG.l -bg $VPIG(C_BG) -font [cbr14] \
                 -text "工作组: "
   entry $W_FG.e -bg [c_yellow] -font [cbr14] \
         -textvariable APP_GEN_G(SYSADMIN_GROUP_NAME) -width 15
   pack $W_FG.l $W_FG.e -side left

   frame $W_LBF -bg $VPIG(C_BG)
   button $W_LBF.install  -text "安装"  -bg [c_aqua]  -font [cbr14] \
         -command [list user_install_cb $USERS_PATH $GROUPS_PATH $W_L]
   button $W_LBF.cancel -text "退出" -bg [c_aqua]  -font [cbr14] \
                        -command [list user_cancel_cb $W_L]
   pack $W_LBF.install $W_LBF.cancel -side left -expand 1 -pady 5

   pack $W_FL $W_FU $W_FP $W_FG $W_LBF -side top -expand 1 -fill x
   pack $W_F -fill x

   set APP_GEN_G(USER_STATUS) 1
   wm transient $W_L $VPIG(WPLUGIN_FRAME)
   tku_center_on_window .  $W_L
   wm deiconify $W_L
   grab set $W_L
   vwait APP_GEN_G(USER_STATUS)
   grab release $W_L
   destroy $W_L
   return $APP_GEN_G(USER_STATUS)
}
#..................................................................
proc user_install_cb {USERS_PATH GROUPS_PATH W} {
   global VPIG
   global APP_GEN_G
   set LEGAL {^[a-zA-Z0-9._-]*$}
   set USER_NAME  [string trim $APP_GEN_G(SYSADMIN_USER_NAME)]
   set PASSWORD   [string trim $APP_GEN_G(SYSADMIN_PASSWORD)]
   set GROUP_NAME [string trim $APP_GEN_G(SYSADMIN_GROUP_NAME)]
   set VAL_NAMES [list USER_NAME PASSWORD GROUP_NAME]

   foreach VAL_NAME $VAL_NAMES {
      set VAL [set $VAL_NAME]
      set VAL [string trim $VAL]
      if { [string length $VAL] == 0 } {
         tku_popup_message error ok \
	 "The field $VAL_NAME must be filled !"
	 return
      }
      if {! [regexp $LEGAL $VAL]} {
        tku_popup_message error ok \
    	   "The field $VAL_NAME must contain letters, digits,_-."
         return
      }
   }

   if [catch {open $GROUPS_PATH {WRONLY CREAT}} FP] {
      tku_popup_message error ok $FP
      set APP_GEN_G(USER_STATUS) error
      return
   }
   if [catch { exec $VPIG(CHMOD) 0777 $GROUPS_PATH } RESPONSE] {
        tku_popup_message error ok $RESPONSE
        return "error"
   }
   puts $FP "GRPS {"
   puts $FP "   NAME=$GROUP_NAME"
   puts $FP "   PRIV=100"
   puts $FP "   AUTOLOGOUT=0"
   puts $FP "   DESC=Sys Admin Group"
   puts $FP "}"
   close $FP

   if [catch {open $USERS_PATH {WRONLY CREAT}} FP] {
      tku_popup_message error ok $FP
      set APP_GEN_G(USER_STATUS) error
      return
   }
   if [catch { exec $VPIG(CHMOD) 0777 $USERS_PATH } RESPONSE] {
        tku_popup_message error ok $RESPONSE
        return "error"
   }
   puts $FP "OPRS {"
   puts $FP "   NAME=$USER_NAME"
   puts $FP "   PASSWD=$PASSWORD"
   puts $FP "   PRIV=100"
   puts $FP "   AUTOLOGOUT=0"
   puts $FP "   GROUP=$GROUP_NAME"
   puts $FP "   REAL_NAME=Sys Admin"
   puts $FP "}"
   close $FP

   set APP_GEN_G(USER_STATUS) ok
   grab release $W
   destroy $W
   return
}

#..................................................................
proc user_cancel_cb {W} {
   global VPIG
   global APP_GEN_G

   grab release $W
   destroy $W

   set APP_GEN_G(USER_STATUS) cancel
   return
}

################ Info Section - DATABASE ########################
set APP_GEN_G(DATABASE_INFO) "
Actions performed during the 'Set logical databases' stage:

- If the .../sys/dblist file or .../share/joblist files exists and are not
  empty, the operation is refused, and manual intervention is required.

- The initial contents of the files is written, to accommodate one logical
  database under the tree of the destination directory. A library job
  is set at this location in the joblist file

- A dblist editor window is opened allowing setup of additional entries.
"
#####################################################################
proc app_gen_database_cb {MODE} {
   global VPIG
   global APP_GEN_G
   set JOBLIST_PATH [file join $APP_GEN_G(DEST_PATH) share joblist]
   set DBLIST_PATH  [file join $APP_GEN_G(DEST_PATH) sys dblist]
   set PATH_NAMES [list DBLIST_PATH JOBLIST_PATH]
   set FW_PATH   [file join $APP_GEN_G(DEST_PATH) fw]
   set LIB_PATH  [file join $FW_PATH lib]
   set JOBS_PATH [file join $FW_PATH jobs]

   if { $MODE == "Standard" && $APP_GEN_G(INSTALL_TYPE) != "full" } {
     return "undone"
   }
   set CREATE_NEW(dblist)  1
   set CREATE_NEW(joblist) 1
   foreach PATH_NAME $PATH_NAMES {
     set PATH [set $PATH_NAME]
     if [file exists $PATH] {
       if { [file size $PATH] > 0 } {
         tku_popup_message warning ok \
           "The file $PATH exists and will\
          \nNOT be overridden automatically.\
          \nYou must manually remove it from the database first."
	  set NAME [file tail $PATH]
         set CREATE_NEW($NAME) 0
       }
     }
   }
   if { $CREATE_NEW(dblist) } {
      if { ! [tclu_is_path_dir $LIB_PATH] } {
        tku_popup_message error ok \
          "The directory $LIB_PATH cannot be found.\
         \nIts should have been loaded from the installation\
         \nmedia."
           return "error"
      }
      if [catch {open $DBLIST_PATH {WRONLY CREAT}} FP] {
        tku_popup_message error ok $FP
        return "error"
      }
      if [catch { exec $VPIG(CHMOD) 0777 $DBLIST_PATH } RESPONSE] {
        tku_popup_message error ok $RESPONSE
        return "error"
      }
      puts $FP "DBS {"
      puts $FP "  NAME=genesis"
      puts $FP "  PATH=$FW_PATH"
      puts $FP "  ACCESS="
      puts $FP "}"
      close $FP
      set STATUS [tclu_mkdir $JOBS_PATH 1]
      if { $STATUS != 0 } {
	return "error"
      }
      if [catch { exec $VPIG(CHMOD) 0777 $JOBS_PATH } RESPONSE] {
        tku_popup_message error ok $RESPONSE
        return "error"
      }
   }
   if { $CREATE_NEW(joblist) } {
      if [catch {open $JOBLIST_PATH {WRONLY CREAT}} FP] {
        tku_popup_message error ok $FP
        return "error"
      }
      if [catch { exec $VPIG(CHMOD) 0777 $JOBLIST_PATH } RESPONSE] {
        tku_popup_message error ok $RESPONSE
        return "error"
      }
      puts $FP "JOBS {"
      puts $FP "  NAME=genesislib"
      puts $FP "  DB=genesis"
      puts $FP "  ACCESS="
      puts $FP "}"
      close $FP
   }
   set CHOICE [tku_popup_message question yesno \
	       "Do you wish to add logical databases to the\
	      \nsys/dblist file ?"]
   if { $CHOICE == "yes" } {
     set STATUS [dblist_editor $DBLIST_PATH]
     if { $STATUS != "ok" } {
          return $STATUS
     }
   }
   return "ok"
}

global APP_GEN_DBNAME
global APP_GEN_DBPATH
#..................................................................
proc dblist_editor {PATH} {
   global VPIG
   global APP_GEN_G
   global APP_GEN_DBNAME
   global APP_GEN_DBPATH

   if [info exists APP_GEN_DBNAME] {
     unset APP_GEN_DBNAME
   }
   if [info exists APP_GEN_DBPATH] {
     unset APP_GEN_DBPATH
   }
   set COUNT 0
  set PAT1 {^[ t]*DBS[ t]*\{}
  set PAT2 {^[ \t]*(NAME|PATH|ACCESS)=(.*)}
  set PAT3 {^[ \t]*\}}

  if [catch {open $PATH RDONLY} FP] {
     tku_popup_message error ok $FP
         return "error"
  }
  set COUNT  0
  set ADD    0
  while { ! [eof $FP] } {
    gets $FP LINE
    if [regexp $PAT1 $LINE] {
      set APP_GEN_DBNAME($COUNT)   ""
      set APP_GEN_DBPATH($COUNT)   ""
      incr COUNT
      set ADD 1
      continue
    }
    if [regexp $PAT2 $LINE match INDEX VALUE] {
      if { $ADD } {
         set ARRAY_NAME APP_GEN_DB$INDEX
         set [set ARRAY_NAME]([expr $COUNT-1]) [string trim $VALUE]
      }
      continue
    }
    if [regexp $PAT3 $LINE match INDEX VALUE] {
      set ADD 0
    }
  }
  close $FP

  set STATUS [dblist_screen]
  if { $STATUS == "cancel" } {
     return ok
  }
  if { $STATUS != "ok" } {
     return $STATUS 	
  }

  if [catch {open $PATH {WRONLY TRUNC} } FP] {
     tku_popup_message error ok $FP
     return "error"
  }

  set COUNT [array size APP_GEN_DBNAME]
  for {set I 0} {$I < $COUNT} {incr I} {
     set NAME   [string trim $APP_GEN_DBNAME($I)]
     set PATH   [string trim $APP_GEN_DBPATH($I)]
     if { [string length $NAME] == 0 || [string length $PATH]==0 } {
        continue
     }
     set STATUS [tclu_mkdir $PATH]
     if { $STATUS != 0 } {
	return "error"
     }
     if [catch { exec $VPIG(CHMOD) 0777 $PATH } RESPONSE] {
        tku_popup_message error ok $RESPONSE
        return "error"
     }
     set JOBS_PATH [file join $PATH jobs]
     set STATUS [tclu_mkdir $JOBS_PATH]
     if { $STATUS != 0 } {
	return "error"
     }
     if [catch { exec $VPIG(CHMOD) 0777 $JOBS_PATH } RESPONSE] {
        tku_popup_message error ok $RESPONSE
        return "error"
     }
	
     puts $FP "DBS \{"
     puts $FP "   NAME=$NAME"
     puts $FP "   PATH=$PATH"
     puts $FP "   ACCESS="
     puts $FP "\}"
  }
  close $FP
  return "ok"
}

#..................................................................
proc dblist_screen {} {
   global VPIG
   global APP_GEN_G
   global APP_GEN_DBNAME
   global APP_GEN_DBPATH

   set COUNT [array size APP_GEN_DBNAME]

  set W_D $VPIG(WPLUGIN_FRAME).w_app_gen_dblist
  set W_F $W_D.f
  set W_FT $W_F.title
  set W_FE $W_F.entries
  set W_FL $W_F.legend
  set W_FB $W_F.buttons
  if { [winfo exists $W_D] } {
      destroy $W_D
  }
  toplevel $W_D
  wm title $W_D "Logical Databases Entry Window"
  frame $W_F -bg $VPIG(C_BG)
  label $W_FT -bg $VPIG(C_BG) -font [cbr18] -relief groove -bd 2\
         -anchor w \
         -text " NAME       PATH"
  pack $W_FT -fill x

  frame $W_FE -bg $VPIG(C_BG) -relief groove -bd 2
  for {set I 0} {$I < $COUNT} {incr I} {
    dblist_screen_row $W_FE $I
  }
  pack $W_FE  -fill x

   frame $W_FL -bg $VPIG(C_BG) -relief groove -bd 2

   frame $W_FL.aqua
   label $W_FL.aqua.c -bg [c_aqua] -text " " -bd 1 -relief solid
   label $W_FL.aqua.t -font [cbr14]  -bg $VPIG(C_BG) \
         -text "Path is a directory containing a library job"
   pack $W_FL.aqua.c $W_FL.aqua.t -side left -fill x

   frame $W_FL.yellow
   label $W_FL.yellow.c -bg [c_yellow] -text " " -bd 1 -relief solid
   label $W_FL.yellow.t -font [cbr14]  -bg $VPIG(C_BG) \
         -text "Path is a directory without a library job"
   pack $W_FL.yellow.c $W_FL.yellow.t -side left

   frame $W_FL.eggyellow
   label $W_FL.eggyellow.c -bg [c_eggyellow] -text " " -bd 1 -relief solid
   label $W_FL.eggyellow.t -font [cbr14]  -bg $VPIG(C_BG) \
         -text "Path points to a file"
   pack $W_FL.eggyellow.c $W_FL.eggyellow.t -side left

   frame $W_FL.red
   label $W_FL.red.c -bg [c_red] -text " " -bd 1 -relief solid
   label $W_FL.red.t -font [cbr14] -bg $VPIG(C_BG) \
         -text "Path does not point to an existing directory"
   pack $W_FL.red.c $W_FL.red.t -side left

   pack $W_FL.aqua $W_FL.yellow $W_FL.eggyellow $W_FL.red \
         -side top -anchor w -padx 100

   frame $W_FB -bg $VPIG(C_BG) -relief groove -bd 2
   button $W_FB.add  -text "Add"  -bg [c_aqua]  -font [cbr14] \
         -command [list dblist_add_cb  $W_FE $COUNT]
   button $W