135 lines
4.8 KiB
Perl
Executable File
135 lines
4.8 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
# app-lib.pl
|
|
# Common functions.
|
|
# STTA Rev. 1.3 Copyright (c) 2001-2004 Jesús Pérez Lorenzo --- license GNU GPL
|
|
# stta: (@#) 1.31051043346- [2004_01_29_102036]
|
|
|
|
$main::config{'app_types_def'}="app_types.def";
|
|
|
|
sub get_tta_app_path
|
|
{
|
|
local $ttavers=&get_ttaversion();
|
|
if ( $ttavers =~ / 3.2/ ) {
|
|
return "$root_directory/$module_name/install/tta/objects/3.2";
|
|
} elsif ( $ttavers =~ / 3.3/ ) {
|
|
return "$root_directory/$module_name/install/tta/objects/3.3";
|
|
} elsif ( $ttavers =~ / 3.4/ ) {
|
|
return "$root_directory/$module_name/install/tta/objects/3.4";
|
|
}
|
|
return "";
|
|
}
|
|
|
|
sub load_tta_apptypes
|
|
{
|
|
local $file_path=&get_tta_app_path();
|
|
local %h_tta_apps=();
|
|
&read_file("$file_path/$config{'app_types_def'}", \%h_tta_apps);
|
|
foreach $l (@lang_order_list) {
|
|
&read_file("$file_path/$config{'app_types_def'}.$l", \%h_tta_apps);
|
|
}
|
|
return %h_tta_apps;
|
|
}
|
|
|
|
# get_tta_appdef($tta_AppType)
|
|
sub get_tta_appdef
|
|
{
|
|
local $file_path=&get_tta_app_path();
|
|
local @appdef=();
|
|
|
|
local $datafile_path="$file_path/$_[0]";
|
|
foreach $l (@lang_order_list) {
|
|
if ( -r "$file_path/$_[0].$l") {
|
|
$datafile_path="$file_path/$_[0].$l";
|
|
last ;
|
|
}
|
|
}
|
|
|
|
open(LOG, $datafile_path) || return @appdef ;
|
|
local $newAtt=0;
|
|
local $lineHelp="";
|
|
local $line="";
|
|
local $nameAtt="";
|
|
local $nameOps="";
|
|
local $opsType="";
|
|
local $lineHelp="";
|
|
while(<LOG>) {
|
|
s/\r|\n//g;
|
|
$line=$_;
|
|
if ( $debug eq 2 ) { print "<tr><td><pre>$_</pre></td></tr>"; }
|
|
if ( $_ =~ /^ --(.*)/ ) {
|
|
if ( $newAtt eq 1 ) {
|
|
push(@appdef, { 'att' => $nameAtt,
|
|
'need' => $needAtt,
|
|
'ops' => $nameOps,
|
|
'opstype' => $opsType,
|
|
'line' => $lineHelp,
|
|
'value' => "",
|
|
'num' => scalar(@appdef) });
|
|
}
|
|
$newAtt=1;
|
|
$nameAtt=$1;
|
|
$nameOps=$1;
|
|
$needAtt=1;
|
|
$lineHelp="";
|
|
if ( $nameAtt =~ /(\S+) (\S+)/ ) {
|
|
$nameAtt=$1;
|
|
$nameOps=$2;
|
|
$text=$nameOps;
|
|
$text=~ s/\|/\\|/g;
|
|
$_=~ s/ $text//;
|
|
}
|
|
$_=~ s/ --$nameAtt//;
|
|
if ( $nameOps =~ /<([^<]+)>/ ) {
|
|
$opsType="input";
|
|
} else { $opsType="select"; }
|
|
if ( $_ ne "" ) { $lineHelp=&stringClip($_,"lead"); }
|
|
if ( $debug eq 2 ) { print "<tr><td><pre>($nameAtt)--($nameOps)--$opsType- $lineHelp </pre></td></tr>";}
|
|
next;
|
|
} elsif ( $_ =~ /^ \[--(.*)\]/ ) {
|
|
if ( $newAtt eq 1 ) {
|
|
push(@appdef, { 'att' => $nameAtt,
|
|
'need' => $needAtt,
|
|
'ops' => $nameOps,
|
|
'opstype' => $opsType,
|
|
'line' => $lineHelp,
|
|
'value' => "",
|
|
'num' => scalar(@appdef) });
|
|
}
|
|
$newAtt=1;
|
|
$nameAtt=$1;
|
|
$nameOps=$1;
|
|
$needAtt=0;
|
|
$lineHelp="";
|
|
if ( $nameAtt =~ /(\S+) (\S+)/ ) {
|
|
$nameAtt=$1;
|
|
$nameOps=$2;
|
|
$text=$nameOps;
|
|
$text=~ s/\|/\\|/g;
|
|
$_=~ s/ $text//;
|
|
}
|
|
$_=~ s/ \[--$nameAtt//;
|
|
$_=~ s/\]//;
|
|
if ( $nameOps =~ /<([^<]+)>/ ) {
|
|
$opsType="input";
|
|
} else { $opsType="select"; }
|
|
if ( $_ ne "" ) { $lineHelp=&stringClip($_,"lead"); }
|
|
if ( $debug eq 2 ) { print "<tr><td><pre>($nameAtt)--($nameOps)--$opsType- $lineHelp </pre></td></tr>"; }
|
|
next;
|
|
} else {
|
|
if ( $newAtt eq 1 && $_ ne "" ) { $lineHelp .= " ".&stringClip($line,"lead"),"<br>\n" ; }
|
|
}
|
|
}
|
|
close(LOG);
|
|
if ( $newAtt eq 1 ) {
|
|
push(@appdef, { 'att' => $nameAtt,
|
|
'need' => $needAtt,
|
|
'ops' => $nameOps,
|
|
'opstype' => $opsType,
|
|
'line' => $lineHelp,
|
|
'value' => "",
|
|
'num' => scalar(@appdef) });
|
|
}
|
|
return @appdef;
|
|
}
|
|
1; # Return true
|