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

Last change on this file since 10099 was 10099, checked in by wiese, 18 months ago

change: toLineProtocol: sort fields

  • Property svn:keywords set to Header
File size: 8.8 KB
Line 
1package Common;
2
3#
4# Some common functions
5#
6# Revision: $Header: trunk/BNC/scripts/Common.pm 10099 2023-06-17 20:56:07Z 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
132 # my $INP;
133 # if ( !open ( $INP, ">>", $idxFil ) ) {
134 # ERROR("Could not append file [$idxFil]: $!");
135 # return 0;
136 # }
137 # print $INP "$newPos\n";
138 # close ($INP);
139 }
140 }
141 else {
142 # initial write
143 blurt( "$newPos\n", $idxFil );
144
145 #writeTextInFile( $idxFil, "$newPos\n" );
146 }
147 }
148 else {
149
150 # Read current position from idxfile
151 # ----------------------------------
152 if ( !-e $idxFil ) {
153 return 0;
154 }
155 my $line = "";
156 my $idx_fh;
157 if ( !open ( $idx_fh, "<", $idxFil ) ) {
158 ERROR("Could not open for read $idxFil: $!");
159 return 0;
160 }
161 while (<$idx_fh>) {
162 if ( $_ =~ /^$filName (\d+)/ ) { # RegEx problematic with getContentFiltered()
163 $line .= $_;
164 $filePos = $1;
165 last;
166 }
167 }
168 close ($idx_fh);
169
170 if ( $line && !$filePos ) {
171 ERROR("Could not read file position in idxfile $idxFil. Weired line \"$line\"");
172 $filePos = 0;
173 }
174
175 if ($filePos) {
176
177 # If the file was meanwhile newly created, e.g. after restart from BNC
178 my $fileSize = -s $file;
179 if ( $filePos > $fileSize ) {
180 WARN "file $file seams to be newly created";
181 DEBUG("size:$fileSize pos:$filePos");
182 $filePos = 0;
183 }
184 }
185 else {
186 WARN("No position entry found in idxfile for \"$filName\"");
187 $filePos = 0;
188 }
189 }
190
191 return $filePos;
192}
193
194#** @function isAlreadyRunning ()
195# @brief Check if this program is already running.
196# @details Usage: isAlreadyRunning() && die "Same job is already running!\n";@n
197# Purpose: e.g. to avoid a program running twice
198# @see bernese gpsutil::check_job()
199# @return pid of already running job else false
200#*
201sub isAlreadyRunning {
202 my ($scriptName) = fileparse($0);
203
204 use Proc::ProcessTable;
205 my $pt = new Proc::ProcessTable;
206 my $pid_found = 0; # from already running job
207 foreach my $p ( @{ $pt->table } ) {
208 my $cmd = $p->cmndline;
209 if ( $cmd =~ /$scriptName/ && $p->pid != $$ ) {
210 next if ( $p->pid == getppid () ); # when started from cron!
211 DEBUG( "Found: " . $p->pid . ", myself: $$" );
212 $pid_found = $p->pid;
213 DEBUG "Process $cmd is running";
214 last;
215 }
216 }
217
218 return $pid_found;
219}
220
221# toLineProtocol($rcd)
222# @brief converts $rcd to InfluxDB line protocol
223# @see https://docs.influxdata.com/influxdb/v2.1/reference/syntax/line-protocol/
224sub toLineProtocol {
225 my ($rcd) = @_;
226
227 my $err = 0;
228 my $str = $rcd->{'measurement'} . ',';
229
230 # Tags (sort by key (in lexicographic order) for performance reasons)
231 foreach ( sort { lc ($a) cmp lc ($b) } keys %{ $rcd->{'tags'} } ) {
232 if ( !exists $rcd->{'tags'}->{$_} ) {
233 $err++;
234
235 #next; # ?
236 }
237 $str .= $_ . "=" . $rcd->{'tags'}->{$_} . ",";
238 }
239 chop $str;
240 $str .= " ";
241
242 # Fields
243 foreach ( sort { lc ($a) cmp lc ($b) } keys %{ $rcd->{'fields'} } ) {
244 if ( !exists $rcd->{'fields'}->{$_} ) {
245 $err++;
246
247 #next; # ?
248 }
249 $str .= $_ . "=" . $rcd->{'fields'}->{$_} . ",";
250 }
251 chop $str;
252 $str .= " " . $rcd->{'time'}; # prec=s
253 if ($err) {
254 return 0;
255 }
256 return $str;
257}
258
259#** @function rms ($numbers)
260# @brief Compute the Root mean square.
261# @param $numbers [required] List with your numbers
262# @return RMS value
263# @note use PDL stats() if installed!
264# @see http://rosettacode.org/wiki/Averages/Root_mean_square#Perl
265#*
266sub rms {
267 my $r = 0;
268 $r += $_**2 for @_;
269 return sqrt ( $r / @_ );
270}
271
272#** @function avg ($numbers)
273# @brief Compute the arithmetic mean value.
274# @param $numbers [required] List with your numbers
275# @note use PDL stats() if installed!
276# @return mean value
277# @see http://rosettacode.org/wiki/Average/Arithmetic_mean#Perl
278#*
279sub avg {
280 @_ or return 0;
281 my $sum = 0;
282 $sum += $_ foreach @_;
283 return $sum / @_;
284}
285
286#** @function sigma ($numbers)
287# @brief Compute the STDDEV of the arithmetic mean.
288# @param $numbers [required] List with your numbers
289# @return Sigma value
290# @note use use PDL::Primitive qw(stats) if installed!
291#*
292sub sigma {
293 my $n = scalar (@_);
294
295 if ( $n == 1 ) {
296 WARN "Could not compute sigma for only one sample";
297 return;
298 }
299
300 my $e = 0; # arithm. Mittel
301 $e += $_ for @_;
302 $e = $e / $n;
303
304 my @v = map { $e - $_ } @_;
305 my $vv = 0;
306 $vv += $_**2 for @v;
307 return sqrt ( $vv / ( $n * ( $n - 1 ) ) );
308}
309
310#** @function median (@numbers)
311# @brief Compute the median of a list of numbers.
312# @param @numbers [required] List with your numbers
313# @see https://en.wikipedia.org/wiki/Median
314# @note use PDL stats() if installed!
315# @return median
316#*
317sub median {
318 my $mid = int ( @_ / 2 );
319 my @sorted = sort { $a <=> $b } (@_);
320 if ( @sorted % 2 ) {
321 return $sorted[$mid];
322 }
323 else {
324 return ( $sorted[ $mid - 1 ] + $sorted[$mid] ) / 2;
325 }
326
327 return; # undef
328}
329
3301; # End of Common
331
Note: See TracBrowser for help on using the repository browser.