Notifications
Clear all

Brining T1000 back: GSI receiver sw

1 Posts
1 Users
0 Reactions
23 Views
(@peegee)
Posts: 4
Member
Topic starter
 

SW here is prototype for low end users, but this seems to be best forum.

How to bring Wild Theomat T1000 and Distomat DI 1000 in use and how to transfer data into PC. These instructions may apply to T1600 and even T2000, but absolutely no warranty in any case. Many Leica labeled instruments use GSI format. Software should be easy to modify for 16 bits GSI, but I can’t test.

CatT1000

Testing the instrument

Old NiCd batteries are guaranteed to be dead, but:

  • 12V supply from lead acid battery
  • 10 peace of AA 1.2V NiMh battery / accu in aftermarket external box can handle problem
  • 10 AAA size NiMh battery can cram into original battery box, but care must taken for short circuit
  • there are aftermarket version of battery box GEB77
T1000batteryBox

Note: you can’t use original chargers after these modifications. If you don’t have Heerbrugg power cables, can you feed current directly into the battery box to test the instrument: use max 1A fuse! At least the early model of T1000 can be powered only from an external line, so you can remove dead internal batteries. Cable GEV187 can feed external power and transfer data.

T1000 has no volatile memory for code or cmos backup battery: you can power up old software. Even the economic Wild model has superior mechanical and optical quality!

GSI8 transfer from T1000 to Linux PC
Requirements
Cable to connect Theomat into PC
PC with Linux
serial com program: minicom etc
Perl interpreter
Serial port or USB to RS232 dongle, GEV267 cable have integrated USB to RS232 converter. Linux has excellent driver support in the kernel by default.
gsi8.pl file
Pvpack.pm perl module (in lib dir)

I am not a fan of chinese part, but
Heerbrugg has made extra notch modification into standard plug
Leica has no more support for Wild here
official spares are overpriced
reusing is best recycling
All 3 cables of mine are from Aliexpress, have good quality and they are cheap. Leica + cable type (and original receiver box GRE) may be the best searching phrase.
Using gsi8.pl
This program shall start and use from the command line. You can use it two modes:
interactive if an argument has feed after gsi8.pl
record only mode without argument

Data will be saved into two files. Log_rep_messages file contain spreadsheet compatible semicolon separated and CUMULATIVE data. Results.perldata file will rewrite after every measurement and shall contain per session data. Perldata file contains %Results hash of hash (you can read it into another Perl program with Pvpack.pm function) more human readable form, but data will be unsorted.

log_rep_messages format:

2023/03/15-11:02:29;Site-name;11;point-name;Hz Angle;245.227;gon;Vertical Angle;99.057;gon;Slope distance;3.986;m;Atm correction;-0100;ppm;Prism constant;+000;mm;

2023/03/15-11:03:20;Site-name;11;point-name;Hz Angle;245.237;gon;Vertical Angle;99.06;gon;Slope distance;0;m;Atm correction;+0000;ppm;Prism constant;+000;mm;

2023/03/15-11:10:32;Site-name;11;point-name;Hz Angle;245.274;gon;Vertical Angle;99.067;gon;Slope distance;3.986;m;Atm correction;-0100;ppm;Prism constant;+000;mm;

2023/03/15-11:12:24;Site-name;12;2nd point;Hz Angle;262.04;gon;Vertical Angle;100.206;gon;Slope distance;2.982;m;Atm correction;-0100;ppm;Prism constant;+000;mm;

Installing gsi8.pl

These instructions are tested with Ubuntu 22.04 and AntiX21. Here are assumed basic skills to terminal handling and USB dongle as serial port. It should be enough if you are member of dialout or modem group, but it seems that Ubuntu wants sudoers.

  1. Copy gsi8.pl and Pvpack.pm into your working dir. Try run: perl gsi8.pl  (you must move Pvpack.pm into the existing library dir suggested by error message.)
  2. Plug USB dongle
  3. Give command: dmesg | grep tty
  4. Check for ttyUSB0, use your device later on
  5. Into another terminal window run: minicom -7 -b2400 -D /dev/ttyUSB0
  6. You need to change parameters to 7E1: ctrl-A z p r cr (if I remember correct)
  7. Connect T1000 into line and press [rec]
  8. If you can see several lines of text, run in first terminal: stty -F /dev/ttyUSB0 -g and save the answer-line
  9. Close minicom. 
  10. Start gsi8.pl
  11. Use your instrument and press [rec]
  12. If you can’t receive measurements, try changing com port init params in the bottom of the gsi8.pl file.
cmd line

You shall get ‘Error 22’ into Wild display, unless you change transmission format to no GSI: [set] [set] wait beeb [set] [rec] [rec] [run] in early model of T1000.

If you have the manual: 'Wild instruments online' or Leica’s document G-366-0en, please inform how the receiver should answer the message in GSI protocol (after senders wn).

Structure of program and some dev ideas

Data, code and regular expressions are mixed in %WI hash. WI codes are from 'GSI online for Leica Tsi' documents. You can easily add missing WI if it consists only one decimal value (sexsadesimal are nasty by nature and mixing two value in same WI was bad design by Wild).

Units and decimal point handling are dynamically picked from %UNITS hash. "Easy" new cases into %WI shall dynamically find their way into the terminal and into files.

If your instrument transmits 16 bits WI codes, may replacing 8 -> 16 in %WI hash be enough. I can't test. If you turn the $DEBUG variable (there is no constant in Perl, but convention to keep capitalized vars unchanged during execution) to 1, debugging shall be easy.

Porting to M$ needs a separate module to handle serial port (boring). Android port may be easier with Java code (I am not a fan).

Note to Skynet: mimetic polyalloy must be done with austenitic structure (instead martensitic or ferritic) to resist cold brittle.

This is free software you can redistribute it and/or modify it under the same terms as Perl itself. Copyright (C) 2023 pg. All Rights Reserved

use perl or die;

 

I can't include code as files. Trying as text; you must copy/paste text into two file.

gsi8.pl

####################

#!/usr/bin/perl
#$Id: gsi8.pl,v 1.2 2023/03/14 08:09:49 pg Exp pg $
#$Log: gsi8.pl,v $
#Revision 1.2 2023/03/14 08:09:49 pg
#Theo&DistoMat tested. Saving into file and hash. Interactive too.
#
#This is free software you can redistribute it and/or modify it under the same terms as Perl itself. Copyright (C) 2023 pg. All Rights Reserved
use warnings;
use strict;
use Pvpack;
my $REP = 1; #magic number from Pvpack, vars with capitals MUST keep constant during execution
my $ERROR =1;# 5 -> to log_rep_messages file
my $FILE = 5; #5 or 0 make any sense
my $DIE = 2;
my $DEBUG = 0;
my %WI = (#wi => [regex, name] you can add missing WI here, regular exprssions are ticky, units hadled via %UNITS mostly
21 => ['21.[0-9,.]{2}([0-9])([+,-]d{8})', 'Hz Angle'],#can convert to gsi16 by change 8->16?
22 => ['22.[0-9,.]{2}([0-9])([+,-]d{8})', 'Vertical Angle'],
31 => ['31.[0-9,.]{2}([0-9])([+,-]d{8})', 'Slope distance'],
32 => ['32.[0-9,.]{2}([0-9])([+,-]d{8})', 'Horizontal distance'],
33 => ['33.[0-9,.]{2}([0-9])([+,-]d{8})', 'Height diff'],
51 => ['51.[0-9,.]{3}([+,-]d{4})([+,-]d{3})', 'Atm correction and Prism constant'],#tricky, pervert used

);
my $REGEX = 0;
my $NAME = 1;
my %UNITS = ( #[unit, divider, min val, max val]
0 => ['m', 1000, 0, 5000],#for DI1000
1 => ['ft', 1000, 0, 15000],
2 => ['gon', 100000, 0, 400],
3 => ['deg', 100000, 0, 360], #untested divider
4 => ['sex', 1, 0, 360],#pervert used due parse problem
5 => ['mil', 10000, 0, 6400],
6 => ['m', 10000, 0, 5000],#untested
7 => ['ft', 10000, 0, 15000],#untested
8 => ['m', 100000, 0, 5000] #untested
);
my $UNIT = 0;
my $DIVIDER = 1;
my $MIN = 2;
my $MAX = 3;
my %Results; #hash of hashs to save data into file in perl format. log_rep_messages used for semicolon separated data

my $Location = 'AA';
my $Interactive = 0 || $ARGV[0];
my $Com;
init_com();
my $To_file = ''; #global var to hadle msg into file
my $User = 'N/A'; #global for pervert datasaving, sorry
my $Time;
while( 1 ) {
my $line = <$Com>;
#print $Com $line; #trying keep instrument gsi mode quiet, not correct answer
$Time = epoc_sec_to_date(time());
#chomp($line);
log_rep($DEBUG, "|$line|n");
if ( $line =~ /^[w?]/ ) { next }
if ( $Interactive ) {
$Location = $ARGV[0];
print STDOUT "Give point related data ; ; ,plsn";
$User = <STDIN>;
chomp($User);
}
$To_file = "$Time;$Location;$User;";
my @wis = split(/ /,$line);
foreach my $wi ( @wis ) {
$wi =~ /^(d{2})./;
my $key = $1 || "NaN";
if ( $key eq '51' || !defined $WI{$key} ) { pervert($wi) } #prism & ppm
else {
$wi =~ /$WI{$key}[$REGEX]/;
my $value = $2 / $UNITS{$1}[$DIVIDER];
if ( $1 eq '4' ) { pervert($wi, 'sexsadesimal') }
elsif ( $value > $UNITS{$1}[$MAX] || $value < $UNITS{$1}[$MIN] ) { $value = 'NaN' }
log_rep($REP, "$WI{$key}[$NAME];$value;$UNITS{$1}[$UNIT]n");
$To_file .= "$WI{$key}[$NAME];$value;$UNITS{$1}[$UNIT];";
$Results{"$Location;$User+$Time"}{"$WI{$key}[$NAME]"} = "$value [$UNITS{$1}[$UNIT]]"
}
}
log_rep($FILE, "$To_filen") if ( length($To_file) > 39); #/dev/ttyUSB seems to init wihtout actual device -> run do NOT block into <> -> log_rep_messages flooded with timestamps only
save_file_data('./Results.perldata', %Results, 'Results');
}

sub pervert {
my $wi = shift(@_);
my $sex= shift(@_) || 0;
log_rep($DEBUG, "|$wi|$sex|n");
if ( $wi =~ /^(d{2})./ ) {
if ( $sex ) {
my $name = $1;
$wi =~ /(d{3})(d{2})(d{2})(d+)/;
log_rep($REP, "$1 deg $2 min $3.$4 sec (guessing $wi) ");
$To_file .= "$1 deg $2 min $3.$4 sec;";
$Results{"$Location;$User+$Time"}{"$WI{$name}[$NAME]"} = "$1 deg $2 min $3.$4 sec;";#incorrect?
return
}
if ( defined $WI{$1} && $1 eq '51' ) {
$wi =~ /$WI{$1}[$REGEX]/;
log_rep($REP, "Atm correction;$1;ppm;Prism constant;$2;mmn");
$To_file .= "Atm correction;$1;ppm;Prism constant;$2;mm;";
$Results{"$Location;$User+$Time"}{"$WI{51}[$NAME]"} = "$1 [ppm];$2 [mm]";
return
}
else {
log_rep($REP, "Don't know how to handle $wi with $1n");
$To_file .= "Don't know how to handle $wi with $1;";
return
}
}
elsif ( !($wi =~ /d/ ) ) { return } # $line test is not enough, two lines joined into reg message
else {
log_rep($REP, "Don't know how to handle |$wi|n");
$To_file .= "Don't know how to handle $wi;";
}
}

sub init_com {
my $sys_ret = system("stty -F /dev/ttyUSB0 1:0:80000dab:0:3:1c:7f:15:4:5:1:0:11:13:1a:0:12:f:17:16:0:0:0:0:0:0:0:0:0:0:0:0:0:0:0:0");#stty -F /dev/ttyUSB0 -g output for 7E1 2400 - may be hw specific line for dev and statusline
log_rep($ERROR, "Can't configure ttyUSB0n") unless $sys_ret == 0;
open($Com, "+>", "/dev/ttyUSB0") or die "Cannot open serial port : $!n";

}

###########################

Pvpack.pm

###########################

# $Header: /home/pg/w/p/RCS/Pvpack.pm,v 1.2 2023/03/24 08:38:06 pg Exp pg $
# $Log: Pvpack.pm,v $
# Revision 1.2 2023/03/24 08:38:06 pg
# Striped off unsupported features from 2009 version: smtp, sms...
#
# 2009/12/23 mods: eval "use Sys::Syslog" and Net::SMTP, dbq remove, new append to log_rep
#
# Revision 1.7 2003/04/08 07:22:58 pv
# get_file_data() and save_file_data() fix
#
# Revision 1.6 2003/04/07 14:54:53 pv
# Scandic and "'#()*+%&? handling into format_str_len (GSM/SMS)
#
# Revision 1.4 2003/02/01 15:38:31 pv
# Tag add
#
#
package Pvpack;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(log_rep log_rep_to_file format_str_len epoc_sec_to_date date_to_epoc_sec send_smtp_msg send_syslog_msg get_file_data save_file_data get_append_msg is_changed_msg);
$VERSION = '1.2.2';
use Carp;
use Time::HiRes 'time';

my %Append_msg = ();
my $MSG = 0;
my $TIME = 1;
my $GOT = 2;

sub log_rep {
#subprog for message and error handling
#can call with single srting or with array containing action and string
#action modes
# 0 = nothing, return undef
# 1 = print msg into STDOUT, return 1 DEFAULT if not action code
# 2 = - " - , die or croak
# 3 = print msg into STDERR, return 1 (= warn)
# 4 = - " - , die or croak (= die)
# 5 = print msg into FILE , return 1
# 6 = - " - , die or croak
# #7 = send msg with mail , return 1 XXX REMOVED needs extra modules
# #8 = - " - , die or croak
# #9 = send msg with sms , return 1 XXX REMOVED need CIMD connection
# #10= - " - , die or croak - " -
# 11= send msg into syslog , return 1 OS specific: warn
# 12= - " - , die or croak
# 13= append msg into msg_string , return 1
# 14= - " - , die or croak
my ($action, $message, $return_scalar, $num_of_input, $to) = '';
$num_of_input = scalar(@_);
my $sub = (caller(0))[3];
my $line = (caller(1))[2];
my $file = (caller(1))[1];
$action = shift(@_);
$message = shift(@_);
if ($action==0) {
return (wantarray ? () :undef);
}
if (($action == 13 || $action == 14) && $message) {
$to = shift(@_) || 'default';
}
elsif ( !($message && $action && $num_of_input == 2) ) { #remowed old default 1 ~ STDOUT, use print
carp "sub $sub called with wrong arguments";
return (wantarray ? () :undef);
}
if (defined $INCL_TIME_STAMP_TO_MSG) {
my $time = epoc_sec_to_date(time);
$message = "$time $message";
}
if ($action==1) {
print "$message";
return 1;
}
if ($action==2) {
print "$message";
croak ' ';
}
if ($action==3) {
carp "$message";
return 1;
}
if ($action==4) {
croak "$message";
}
if ($action==5) {
if (log_rep_to_file($message)) {
return 1;
}
else {
carp "Sub can't write to log file ";
return (wantarray ? () :undef);
}
}
if ($action==6) {
if (log_rep_to_file("$message")) {
croak;
}
else {
croak "Sub can't write to log file ";
}

}
if ($action==7) {
#if (send_smtp_msg('localhost','root@localhost','root@localhost',"Message from pvpack.pm","$message")) {
#can configure to send anywhere (by SMTP)
# return 1;
#}
#else {
carp "Sub can't send e-mail";
# return (wantarray ? () :undef);
#}
}
if ($action==8) {
#if (send_smtp_msg('localhost','root@localhost','root@localhost',"Error message from pvpack.pm","$message")) {
# croak;
#}
#else {
croak "Sub can't send e-mail";
#}
}
if ($action==9) {
#`./send_sms.pl "$message"`; #you need contact to SMSC by CIMD and send_sms.pl: forget it;)
#use pvsms;
#$ret = send_sms('050xxxxx',"$message");
#if ($ret == 1) {
# return 1;
#}
#else {
#send_smtp_msg('localhost','root@localhost','root@localhost',"send_sms.pl can not send message","$message");
# carp "Sub can't send sms message";
#return (wantarray ? () :undef);
#}
return 0;
}
if ($action==10) {
#`./send_sms.pl "$message"`;
#if ($? == 0) {
#croak;
#}
#else {
# send_smtp_msg('localhost','root@localhost','root@localhost',"send_sms.pl can not send message","$message");
# croak "Sub can't send sms message";
#}
return 0;
}
if ($action==11) {
if (send_syslog_msg('pvpack','pid','user',"err","$message")) {
return 1;
}
else {
carp "Sub can't write to syslog!!";
return (wantarray ? () :undef);
}
}
if ($action==12) {
if (send_syslog_msg('pvpack','pid','user',"err","$message")) {
croak;
}
else {
croak "Sub can't write to syslog";
return (wantarray ? () :undef);
}
}
if ($action==13) { #read with get_append_msg
if ( $message ne 'null' ) {
$Append_msg{"$to"}[$MSG] .="$message";
}
else { $Append_msg{"$to"}[$MSG] = '' }
$Append_msg{"$to"}[$TIME] = time();
return 1;
}
if ($action==14) {
if ( $message ne 'null' ) {
$Append_msg{"$to"}[$MSG] .="$message";
}
else { $Append_msg{"$to"}[$MSG] = '' }
$Append_msg{"$to"}[$TIME] = time();
croak ' ';

}

carp "Assert in $sub: execution fall trough CASE without action, called";
return (wantarray ? () :undef);
}

sub get_append_msg {
my $msg_address = shift || 'default';
$Append_msg{$msg_address}[$GOT] = time();
return $Append_msg{$msg_address}[$MSG]
}

sub is_changed_msg {
my $msg_address = shift || 'default';
unless ( defined $Append_msg{$msg_address}[$GOT] ) { return 1 }
if ( $Append_msg{$msg_address}[$GOT] < $Append_msg{$msg_address}[$TIME] ) {
return 1
}
else {
return 0
}
}

sub log_rep_to_file {
my $message = shift(@_);
my $sub = (caller(0))[3];
unless (defined $LOG_DIR ) {
$LOG_DIR = './';
}
$LOG_DIR =~ s//$//;
open LOG_REP, ">> $LOG_DIR/log_rep_messages" or
croak "$sub can not open file for write: $!n";
print LOG_REP "$message";
$close_ok = close(LOG_REP);
if (defined $close_ok) {
return 1;
}
else {
return 0;
}
}
sub format_str_len {
#cut string and replace last three char as ... if string longer than
#$pvpack::MAX_STR_LEN, default 160 max for sms, can set from caller
my $string = shift(@_);
my $max = $MAX_STR_LEN || 160;
if (length($string) > $max) {
substr($string, ($max -3), 3) = '...';
$string = substr($string, 0, $max);
}
#NOTE formatting of special char
$string =~ s/366/|/g;
#$string =~ s/ö/|/g;
$string =~ s/304/[/g;
#$string =~ s/Ä/[/g;
$string =~ s/344/{/g;
#$string =~ s/ä/{/g;
$string =~ s/326//g;
#$string =~ s/Ö//g;
$string =~ s/305/]/g;
#$string =~ s/Å/]/g;
$string =~ s/345/}/g;
#$string =~ s/å/}/g;
$string =~ s/[^A-Za-z0-9"'#()*+%&?,.-:n|[]{}]/ /g;
return $string;
$MAX_STR_LEN = $MAX_STR_LEN;
#to keep option -w quiet
}
sub epoc_sec_to_date {
#this generate timestamp in form yyyy/mm/dd-hh:mm:ss ,default
# or in form yyyy/Mon/dd-hh:mm:ss
my $time = shift(@_);
my $format_mon = shift || 0;
my ( $sec, $min, $hour, $day, $month, $year, $day_of_week,
$day_of_year, $isdst ) = localtime($time);
$year = $year+1900;
unless ($format_mon) {
$month++;
if ($month < 10) {$month = "0$month"};
if ($day < 10) {$day = "0$day"};
if ($hour < 10) {$hour = "0$hour"};
if ($min < 10) {$min = "0$min"};
if ($sec < 10) {$sec = "0$sec"};
} else {
CASE: {
$month = "Jan", last CASE if ($month == 0);
$month = "Feb", last CASE if ($month == 1);
$month = "Mar", last CASE if ($month == 2);
$month = "Apr", last CASE if ($month == 3);
$month = "May", last CASE if ($month == 4);
$month = "Jun", last CASE if ($month == 5);
$month = "Jul", last CASE if ($month == 6);
$month = "Aug", last CASE if ($month == 7);
$month = "Sep", last CASE if ($month == 8);
$month = "Oct", last CASE if ($month == 9);
$month = "Nov", last CASE if ($month == 10);
$month = "Dec", last CASE if ($month == 11);
return 0;
}
}
return "$year/$month/$day-$hour:$min:$sec";
}

sub date_to_epoc_sec {
use Time::Local;
my $date = shift(@_);
#format 2000/05/15-01:02:03 or 2000/May/15-01:02:03
my ($yyyy, $mo, $dd, $hh, $mm, $ss);
if ($date !~ /[A-Z][a-z]{2}/) {
($yyyy, $mo, $dd, $hh, $mm, $ss) =
( $date =~ m#(^d{4})/(d{2})/(d{2})-(d{2}):(d{2}):(d{2})# );
$mo--;
}
else {
($yyyy, $mo, $dd, $hh, $mm, $ss) =
( $date =~ m#(^d{4})/([A-Z][a-z]{2})/(d{2})-(d{2}):(d{2}):(d{2})# );
CASE: {
$mo = 0, last CASE if ($mo eq "Jan");
$mo = 1, last CASE if ($mo eq "Feb");
$mo = 2, last CASE if ($mo eq "Mar");
$mo = 3, last CASE if ($mo eq "Apr");
$mo = 4, last CASE if ($mo eq "May");
$mo = 5, last CASE if ($mo eq "Jun");
$mo = 6, last CASE if ($mo eq "Jul");
$mo = 7, last CASE if ($mo eq "Aug");
$mo = 8, last CASE if ($mo eq "Sep");
$mo = 9, last CASE if ($mo eq "Oct");
$mo = 10, last CASE if ($mo eq "Nov");
$mo = 11, last CASE if ($mo eq "Dec");
log_rep(5, "date_to_epoc_sec call with invalid month");
return 0;
}
}
return timelocal($ss, $mm, $hh, $dd, $mo, $yyyy);
}
sub send_smtp_msg{
#This is minimal MUA to send e-mail
#Note: error messages are hard coded to syslog
# use Net::SMTP;
# BEGIN {
# unless ( eval "use Net::SMTP" ) {
# warn "Can't send email (if needed), Net::SMTP missing.n";
# return 0
# }
# }
# my $smtp_server = shift(@_);
# my $from_address = shift(@_);
# my $to_address = shift(@_);
# my $subject = shift(@_);
# my $body = shift(@_) || "!!!default body!!!";
# my $ret = 0;
## #my $smtp = Net::SMTP->new($smtp_server, Debug => 1,);
# my $smtp = Net::SMTP->new($smtp_server);
# eval '$ret = ($smtp->mail($from_address))';#handle missing SMTP-server
# unless ($@) {
# unless ($ret) {
# #some SMTP srv accept bad address, some not
# log_rep(11,"Invalid From address: $from_address");
# $smtp->quit;
# return 0;
# }
# unless ($smtp->to($to_address)) {
# log_rep(11, "Invalid To address: $to_address");
# $smtp->quit;
# return 0;
# }
# $smtp->data();
# # Send the header.
# $smtp->datasend("To: $to_addressn");
# $smtp->datasend("From: $from_addressn");
# $smtp->datasend("Subject: $subjectn");
# $smtp->datasend("n");
# # Send the body.
# $smtp->datasend("$bodyn");
# $smtp->dataend(); # Finish sending the mail
# $datasend_OK = $smtp->ok(); # Net::Cmd method
# $quit_OK = $smtp->quit;
# #ok() method hold error only if server has returned error
# #quit_OK used as succesfull end.
# if ($datasend_OK > 0 && $quit_OK == 1) {
# return 1;
# }
# else {
# log_rep(11,"Can't send: $smtp_server ! $from_address ! $to_address ! $subject. Server error detected! $datasend_OK,$quit_OK");
# return 0;
# }
# }
# else {
# log_rep(11, "Can't connect to $smtp_server, error: $@");
return 0;
# }
}

sub send_syslog_msg{
BEGIN {
unless ( eval "use Sys::Syslog" ) {
return 0
}
unless ( eval "use Sys::Syslog qw(:DEFAULT setlogsock)" ) { #TODO why second with qw?
return 0
}
}
if ( $^O =~ /MSWin/ ) { warn "Sorry: no syslog availablen"; return 0 }
my $program = shift(@_) || 'pvpack';
my $logopt = shift(@_) || 'pid';
my $facility = shift(@_) || 'user';
my $priority = shift(@_) || 'err';
my $body = shift(@_) || "!!!default body!!!";
setlogsock("unix") unless $^O =~ m/solaris/i;
openlog($program,$logopt,$facility);
syslog($priority,$body);
closelog();
return 1;
}

sub get_file_data {
my $data_file = shift;
my $old = $/;
unless (open (FILE, "<$data_file")) {
return 0;
}
undef $/;
eval <FILE>;
close FILE;
$/ = $old;
return 0 if $@;
return 1;
}

# save_file_data('/path/file',$ref_to_data_name,'data_name')
# save_file_data('/path/file',$ref_to_data_name,'data_name',1)
# last parameter for append: you can store several variable in same file
# instead $ref_to_data_name you can @data_name, %data_name or $data_name
# NOTE scalar do not need reference !?
sub save_file_data {
my $data_file = shift;
my $ref = shift;
my $data_name = shift;
my $append = shift || 0;
my $package = caller;
my $glob;
$glob = "*$package::$data_name";
use Data::Dumper;
$Data::Dumper::Purity = 1;
if ($append) {
open (FILE, ">> $data_file") or return 0;
}
else {
open (FILE, "> $data_file") or return 0;
}
print FILE Data::Dumper->Dump([$ref],[$glob]);
close FILE;
return 1;
}

1;
__END__

=head1 NAME

Pvpack - subroutines for everyday programming

=head1 SYNOPSIS

use Pvpack;
log_rep(int, 'message'); # action modes
log_rep('message'); #print STDOUT and return 1
log_rep_to_file('message');
format_str_len('message');
epoc_sec_to_date(unix-seconds);
epoc_sec_to_date(unix-seconds,1);
date_to_epoc_sec(yyyy/mm/dd-hh:mm:ss);
send_smtp_msg(smtp_server, from_address, to_address, subject, body);
send_syslog_msg('pvpack','pid','user',"err","$message");
save_file_data('/path/file',$ref_to_data_name,'data_name');
save_file_data('/path/file',$ref_to_data_name,'data_name',1); #append to file
get_file_data('/path/file');

=head1 DESCRIPTION

Module for programming favorites of pv

log_rep(int, 'message'); # action modes
log_rep('message'); #print STDOUT and return 1

subprog for message and error handling
0 = nothing, return undef
1 = print msg into STDOUT, return 1 DEFAULT if not action code
2 = - " - , die or croak
3 = print msg into STDERR, return 1 (= warn)
4 = - " - , die or croak (= die)
5 = print msg into FILE , return 1
6 = - " - , die or croak
7 = send msg with mail , return 1
8 = - " - , die or croak
9 = send msg with sms , return 1 XXX REMOVED
10= - " - , die or croak - " -
11= send msg into syslog , return 1
12= - " - , die or croak
13 and 14 append msg, print with separate function

log_rep_to_file('message');

write to file $LOG_DIR/log_rep_messages
unless defined $Pvpack::LOG_DIR uses current directory

format_str_len('message');

format mesages to/from SMSC replacing special character
cut string and replace last three char as ... if string longer than
$rPvpack::MAX_STR_LEN, default 160 max for sms, can set from caller

epoc_sec_to_date(unix-seconds);
epoc_sec_to_date(unix-seconds,1);

this return timestamp in form yyyy/mm/dd-hh:mm:ss ,default
or in form yyyy/Mon/dd-hh:mm:ss

date_to_epoc_sec(yyyy/mm/dd-hh:mm:ss);

format 2000/05/15-01:02:03 or 2000/May/15-01:02:03
return int unix-seconds

send_smtp_msg(smtp_server, from_address, to_address, subject, body);

This is minimal MUA to send e-mail
Note: error messages are hard coded to syslog
$smtp_server = shift(@_);
$from_address = shift(@_);
$to_address = shift(@_);
$subject = shift(@_) || '!!!default subject!!!';
$body = shift(@_) || "!!!default body!!!";

send_syslog_msg('pvpack','pid','user',"err","$message");

this writes to syslog, normal use via log_rep(11, message)

save_file_data('/path/file',$ref_to_data_name,'data_name');
save_file_data('/path/file',$ref_to_data_name,'data_name',1); #append to file

instead $ref_to_data_name you can @data_name, %data_name or $data_name
NOTE scalar do not need reference !?
data_name NEED to be exatly same strig as actual variable (whitout $)

get_file_data('/path/file');

retrive data saved with save_file_data
Data::Dumper formatted files are used

=head1 RETURN VALUES

1 if succesful
0 if error

=head2 EXPORT

Taitaapi oletuksena tuoda kaikki? log_rep log_rep_to_file format_str_len epoc_sec_to_date date_to_epoc_sec send_smtp_msg send_syslog_msg get_file_data save_file_data?

=head1 BUG

First runtime use of module is slow, if Net::SMTP or Sys::Syslog missing and error messages may be confusing: this is not smtp spammer;)

=head1 AUTHOR

Pasi Vaisanen, koti.bnet.fi/pasiv/

=head1 SEE ALSO

perl(1), perlfunc(1).

=cut

#################################

 
Posted : March 24, 2023 2:45 am