source: ntrip/trunk/BNC/scripts/Common.pm@ 9747

Last change on this file since 9747 was 9747, checked in by wiese, 3 months ago

ADD: minor in helper scripts

  • Property svn:keywords set to Header
File size: 8.6 KB
Line 
1package Common;
2
3#
4# Some common functions
5#
6# Revision: $Header: trunk/BNC/scripts/Common.pm 9747 2022-06-01 09:45:39Z wiese $
7#
8
9use strict;
10use warnings;
11use Exporter;
12use Data::Dumper;
13use Log::Log4perl qw(:easy);
14use File::Temp;
15use File::Basename;
16use File::Spec::Functions;
17
18#$| = 1; # Buffer off (print)
19
20sub trim {
21 my ($text) = @_;
22 $text =~ s/^[\s]*//g;
23 $text =~ s/[\s]*$//g;
24 return $text;
25}
26
27# run a command in the shell.
28sub runCmd {
29 my ($cmd) = shift;
30
31 DEBUG("run cmd: \"$cmd\"");
32
33 my $tmpfh = File::Temp->new( UNLINK => 1, SUFFIX => '.dat' );
34 my $tmpfile = $tmpfh->filename();
35
36 $cmd = "$cmd 2>$tmpfile |";
37 my $PIPE;
38 unless ( open $PIPE, $cmd ) {
39 ERROR("open $cmd | failed ($!)");
40 return ( -1, "", "" );
41 }
42 my $stdout = join '', <$PIPE>;
43 close $PIPE;
44 my $exit_code = $?;
45
46 my $stderr = getContent($tmpfile);
47 return ( $exit_code, $stdout, $stderr );
48}
49
50sub mkDir {
51 my $dir = shift;
52 return 1 if ( -d $dir );
53
54 eval { mkpath($dir) };
55 if ($@) {
56 warn("Could not create path [$dir]: $@");
57 return 0;
58 }
59 return 1;
60}
61
62#** @function amInteractiv ()
63# @brief Checks if a program runs interactivly, or e.g. was invoked by cron.
64# @see Perl Cookbook Kap. 15.2
65# @return true if interactive, else false.
66#*
67sub amInteractiv {
68 use POSIX qw(getpgrp tcgetpgrp);
69 my $tty;
70 open ( $tty, "<", "/dev/tty" ) || LOGDIE "Could not open /dev/tty: $!";
71 my $tpgrp = tcgetpgrp( fileno ($tty) ); # get terminal foreground process group
72 my $pgrp = getpgrp (); # get the current process group
73 close $tty;
74 return ( $tpgrp == $pgrp );
75}
76
77#** @function printData ($data)
78# @brief Prints perl data structures. Uses Data::Dumper.
79# @param $data [required] Daten
80# @return -
81#*
82sub printData {
83 my $data = shift;
84 my $d = Data::Dumper->new($data);
85 $d->Indent(3); # pretty print with array indices
86 print $d->Dump;
87}
88
89sub getContent {
90 my ($fileName) = @_;
91 my $errmsg = "";
92 if ( -f $fileName ) {
93 my $readMode = $/;
94 undef $/;
95 open ( FILE, "<", $fileName )
96 or ERROR("Kann Datei nicht zum lesen oeffnen");
97 $errmsg = <FILE>;
98 close (FILE);
99 $/ = $readMode;
100 }
101 return $errmsg;
102}
103
104#** @function filePosition ($file, $filePos)
105# @brief Save position of a file in an idxfile.
106#
107# Especially for logfiles. For performance reasons, logfiles should not parsed always from the
108# beginning, the next read access should start at the pos of the last read.
109# Saves the position of the last read in a help-file ".filePos" in
110# the directory of the logfile. If the param $filePos is set, then this position will be saved (Write).
111# Otherwise the current position will be returned (Read).
112# @param $file [required] File of interest
113# @param $filePos [optional] if given, this position ()in Bytes) will be saved, else return current position
114# @return file position in Bytes from beginning of the file
115#*
116sub filePosition {
117 my ( $file, $filePos ) = @_;
118
119 my ( $filName, $filDir ) = fileparse($file);
120 my $idxFil = catfile( $filDir, ".filePos" );
121
122 if ($filePos) {
123
124 # Save this position in idxfile
125 my $newPos = "$filName $filePos";
126 if ( -e $idxFil ) {
127 unless ( replace( $idxFil, "^${filName} \\d+", $newPos ) ) {
128
129 # could not replace -> append
130 blurt( "$newPos\n", $idxFil, { append => 1 } );
131# my $INP;
132# if ( !open ( $INP, ">>", $idxFil ) ) {
133# ERROR("Could not append file [$idxFil]: $!");
134# return 0;
135# }
136# print $INP "$newPos\n";
137# close ($INP);
138 }
139 }
140 else {
141 # initial write
142 blurt( "$newPos\n", $idxFil );
143 #writeTextInFile( $idxFil, "$newPos\n" );
144 }
145 }
146 else {
147
148 # Read current position from idxfile
149 # ----------------------------------
150 if ( !-e $idxFil ) {
151 return 0;
152 }
153 my $line = "";
154 my $idx_fh;
155 if ( !open ( $idx_fh, "<", $idxFil ) ) {
156 ERROR("Could not open for read $idxFil: $!");
157 return 0;
158 }
159 while (<$idx_fh>) {
160 if ( $_ =~ /^$filName (\d+)/ ) { # RegEx problematic with getContentFiltered()
161 $line .= $_;
162 $filePos = $1;
163 last;
164 }
165 }
166 close ($idx_fh);
167
168 if ( $line && !$filePos ) {
169 ERROR("Could not read file position in idxfile $idxFil. Weired line \"$line\"");
170 $filePos = 0;
171 }
172
173 if ($filePos) {
174
175 # If the file was meanwhile newly created, e.g. after restart from BNC
176 my $fileSize = -s $file;
177 if ( $filePos > $fileSize ) {
178 WARN "file $file seams to be newly created";
179 DEBUG("size:$fileSize pos:$filePos");
180 $filePos = 0;
181 }
182 }
183 else {
184 WARN("No position entry found in idxfile for \"$filName\"");
185 $filePos = 0;
186 }
187 }
188
189 return $filePos;
190}
191
192#** @function isAlreadyRunning ()
193# @brief Check if this program is already running.
194# @details Usage: isAlreadyRunning() && die "Same job is already running!\n";@n
195# Purpose: e.g. to avoid a program running twice
196# @see bernese gpsutil::check_job()
197# @return pid of already running job else false
198#*
199sub isAlreadyRunning {
200 my ($scriptName) = fileparse($0);
201
202 use Proc::ProcessTable;
203 my $pt = new Proc::ProcessTable;
204 my $pid_found = 0; # from already running job
205 foreach my $p ( @{ $pt->table } ) {
206 my $cmd = $p->cmndline;
207 if ( $cmd =~ /$scriptName/ && $p->pid != $$ ) {
208 next if ( $p->pid == getppid () ); # when started from cron!
209 DEBUG( "Found: " . $p->pid . ", myself: $$" );
210 $pid_found = $p->pid;
211 DEBUG "Process $cmd is running";
212 last;
213 }
214 }
215
216 return $pid_found;
217}
218
219# toLineProtocol($rcd)
220# @brief converts $rcd to InfluxDB line protocol
221# @see https://docs.influxdata.com/influxdb/v2.1/reference/syntax/line-protocol/
222sub toLineProtocol {
223 my ($rcd) = @_;
224
225 my $err = 0;
226 my $str = $rcd->{'measurement'} . ',';
227
228 # Tags (sort by key (in lexicographic order) for performance reasons)
229 foreach ( sort { lc ($a) cmp lc ($b) } keys %{ $rcd->{'tags'} } ) {
230 if ( !exists $rcd->{'tags'}->{$_} ) {
231 $err++;
232 #next; # ?
233 }
234 $str .= $_ . "=" . $rcd->{'tags'}->{$_} . ",";
235 }
236 chop $str;
237 $str .= " ";
238
239 # Fields
240 while ( my ( $k, $v ) = each %{ $rcd->{'fields'} } ) {
241 if ( !defined $v ) {
242 $err++;
243 }
244 $str .= $k . "=" . $v . ",";
245 }
246 chop $str;
247 $str .= " " . $rcd->{'time'}; # prec=s
248 if ($err) {
249 return 0;
250 }
251 return $str;
252}
253
254#** @function rms ($numbers)
255# @brief Compute the Root mean square.
256# @param $numbers [required] List with your numbers
257# @return RMS value
258# @note use PDL stats() if installed!
259# @see http://rosettacode.org/wiki/Averages/Root_mean_square#Perl
260#*
261sub rms {
262 my $r = 0;
263 $r += $_**2 for @_;
264 return sqrt ( $r / @_ );
265}
266
267#** @function avg ($numbers)
268# @brief Compute the arithmetic mean value.
269# @param $numbers [required] List with your numbers
270# @note use PDL stats() if installed!
271# @return mean value
272# @see http://rosettacode.org/wiki/Average/Arithmetic_mean#Perl
273#*
274sub avg {
275 @_ or return 0;
276 my $sum = 0;
277 $sum += $_ foreach @_;
278 return $sum / @_;
279}
280
281#** @function sigma ($numbers)
282# @brief Compute the STDDEV of the arithmetic mean.
283# @param $numbers [required] List with your numbers
284# @return Sigma value
285# @note use use PDL::Primitive qw(stats) if installed!
286#*
287sub sigma {
288 my $n = scalar (@_);
289
290 if ( $n == 1 ) {
291 WARN "Could not compute sigma for only one sample";
292 return;
293 }
294
295 my $e = 0; # arithm. Mittel
296 $e += $_ for @_;
297 $e = $e / $n;
298
299 my @v = map { $e - $_ } @_;
300 my $vv = 0;
301 $vv += $_**2 for @v;
302 return sqrt ( $vv / ( $n * ( $n - 1 ) ) );
303}
304
305#** @function median (@numbers)
306# @brief Compute the median of a list of numbers.
307# @param @numbers [required] List with your numbers
308# @see https://en.wikipedia.org/wiki/Median
309# @note use PDL stats() if installed!
310# @return median
311#*
312sub median {
313 my $mid = int ( @_ / 2 );
314 my @sorted = sort { $a <=> $b } (@_);
315 if ( @sorted % 2 ) {
316 return $sorted[$mid];
317 }
318 else {
319 return ( $sorted[ $mid - 1 ] + $sorted[$mid] ) / 2;
320 }
321
322 return; # undef
323}
324
3251; # End of Common
326
Note: See TracBrowser for help on using the repository browser.