package bptm; use v5.10; use DBI; use JSON; use IO::Prompter; use Exporter; use Term::ANSITable; use experimental qw( switch ); use vars qw($VERSION @ISA @EXPORT); $VERSION = 1.00; @ISA = qw(Exporter); @EXPORT = qw/ showtype showpart showset showtrack showmaintenance addtrack addmaintenance addset addtype addpart deltrack delset deltype delpart editpart editset replacepart addatact delatact read_config check_parameter debug %conf /; our $FUNC_STATEMENT_HANDLE; sub get_zip_files ($) { my ($zip_input_dir) = $_[0]; chdir $zip_input_dir; # alle zip files aus input verzeichnis durchlaufen # später nur alle zip files vom vorletzten tag nehmen # $dby=`date +"%Y-%m-%d" -d "-2 days"` # dby daybeforeyesterday # ls $dby*.zip my @zip_files = glob("*.zip"); return @zip_files; } sub get_json_file ($) { my ($zip_file) = $_[0]; chomp $zip_file; # zip file entpacken dabei nur dateien nach dem Muster *_summary.json nehmen `unzip -u -qq $zip_file '*_summary.json'`; # name des json files my $json_file = `ls *_summary.json`; return $json_file; } sub get_values_from_json ($) { my $jfile = $_[0]; open FILE, "<$jfile"; local $/ = undef; my $jcontent = ; close FILE; my $value = decode_json $jcontent; my ($t1,$t2) = $value->{summaryDTO}->{startTimeLocal} =~ /^([0-9-]*)T([0-9:]*)\./; return ($value->{activityId}, $value->{activityName}, $value->{summaryDTO}->{distance}, $value->{summaryDTO}->{duration}, "$t1 $t2", $value->{summaryDTO}->{elevationGain}); } sub check_parameter () { my @pars1 = qw /st at dt sp ap dp rp ss as ds sm am dm sr ar dr em ep es er aa da x/; my @pars2 = qw /all active inactive/; my ($act1,$act2,$act3,$in); my $found = 0; print "\n\n\n"; printf "%-18s %-18s %-18s %-18s\n", "st) Show Types", "at) Add Type", "et) Edit Type", "dt) Delete Type"; printf "%-18s %-18s %-18s %-18s %-18s\n", "sp) Show Parts", "ap) Add Part", "ep) Edit Part", "dp) Delete Part", "rp) Replace Part"; printf "%-18s %-18s %-18s %-18s\n", "ss) Show Sets", "as) Add Set", "es) Edit Set", "ds) Delete Set"; printf "%-18s %-18s %-18s %-18s\n", "sr) Show tRacks", "ar) Add tRack", "er) Edit tRack", "dr) Delete tRack"; printf "%-18s %-18s %-18s %-18s\n", "sm) Show Maint", "am) Add Maint", "em) Edit Maint", "dm) Delete Maint"; printf "\n"; printf "Kurzform von ep) Teile zu Track hinzufügen oder davon entfernen\n"; printf "%-18s %-18s %-18s %-18s\n", "", "aa) Add to Act", "", "da) Del from Act"; printf "\n"; printf "%-18s %-18s %-18s %-18s\n", "x) eXit", "", "", ""; $in = prompt("\nAktivität angeben:", -guarantee=>[@pars1]); $act1 = 'show' if ( $in =~ /^s/ ); $act1 = 'add' if ( $in =~ /^a/ ); $act1 = 'edit' if ( $in =~ /^e/ ); $act1 = 'del' if ( $in =~ /^d/ ); $act1 = 'exit' if ( $in =~ /^x/ ); $act1 = 'replace' if ( $in =~ /^r/ ); $act2 = ''; $act2 = 'type' if ( $in =~ /t$/ ); $act2 = 'part' if ( $in =~ /p$/ ); $act2 = 'set' if ( $in =~ /s$/ ); $act2 = 'track' if ( $in =~ /r$/ ); $act2 = 'maintenance' if ( $in =~ /m$/ ); $act2 = 'atact' if ( $in =~ /a$/ ); if ( $in =~ /^s/ and $in =~ /[tps]$/ ) { given (prompt -k1, "[A]ctive, (I)nactive, or al(L):", -keyletters) { when (/I/i) { $act3="inactive"; } when (/L/i) { $act3="all"; } default { $act3="active"; } } } return ($act1,$act2,$act3); } sub addatact { print "\nAuswahl der Aktivität der ein Teil hinzugefügt werden soll"; showtrack(); my $activity = prompt ('Welche Aktivitäts-ID? ', -text); print "\nAuswahl des Teils das hinzugefügt werden soll\n"; show_part_short(); my $part = prompt ('Welche Teile-ID? ', -text); add_activities_parts($activity,$part); print "\nAlte Werte des Teils\n"; show_onepart_short($part); # werte aus aktivität my $date = get_date_from_act ($activity); my $actd = select_activity_distance($activity); my $acth = select_activity_duration($activity); # werte von teil my $d = select_distance($part); my $dam = select_distance_am($part); my $h = select_duration($part); my $ham = select_duration_am($part); # neue werte berechnen ... my ($newd,$newdam,$newh,$newham); $newd = $d + $actd; $newh = $h + $acth; $newdam = $dam + $actd; $newham = $ham + $acth; # und in teil zurückschreiben update_partlastused($part, $date); update_distance($part,$newd); update_distance_am($part,$newdam); update_duration($part,$newh); update_duration_am($part,$newham); print "\nNeue Werte des Teils\n"; show_onepart_short($part); } sub delatact { print "\nAuswahl der Aktivität von der ein Teil entfernt werden soll"; showtrack(); my $activity = prompt ('Welche Aktivitäts-ID? ', -text); print "\nAuswahl des Teils das entfernt werden soll\n"; show_part_short(); my $part = prompt ('Welche Teile-ID? ', -text); print "\nAuswahl der Aktivität bei der das Teil zuletzt genutzt wurde"; showtrack(); my $last = prompt ('Welche Aktivitäts-ID? ', -text); del_activities_parts($activity,$part); print "\nAlte Werte des Teils\n"; show_onepart_short($part); # werte aus aktivität my $date = get_date_from_act ($last); my $actd = select_activity_distance($activity); my $acth = select_activity_duration($activity); # werte von teil my $d = select_distance($part); my $dam = select_distance_am($part); my $h = select_duration($part); my $ham = select_duration_am($part); # neue werte berechnen ... my ($newd,$newdam,$newh,$newham); $newd = $d - $actd; $newh = $h - $acth; $newdam = $dam - $actd; $newham = $ham - $acth; # und in teil zurückschreiben update_partlastused($part, $date); update_distance($part,$newd); update_distance_am($part,$newdam); update_duration($part,$newh); update_duration_am($part,$newham); print "\nNeue Werte des Teils\n"; show_onepart_short($part); } sub add_track_id_to_db (@) { my ($id,$set,$name,$dist,$dura,$datum,$hm)=@_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_exec($DBH, "INSERT INTO activities set a_activity = '$id', a_set = '$set', a_name = '$name', a_distance = '$dist', a_duration = '$dura', a_date = '$datum', a_hm = '$hm'"); db_disconnect($DBH); } sub track_not_in_db ($) { # return 1 wenn activity id noch nicht in db # return 0 wenn activity id bereits in db my $id=$_[0]; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select a_activity from activities where a_activity = '$id'"); db_disconnect($DBH); if ($res[0][0] eq "$id") { return 0; } else { return 1; } } sub select_duration($) { my $part = $_[0]; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select p_time from parts where p_id = '$part'"); db_disconnect($DBH); return $res[0][0]; } sub select_activity_duration($) { my $act = $_[0]; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select a_duration from activities where a_activity = '$act'"); db_disconnect($DBH); return $res[0][0]; } sub select_duration_am($) { my $part = $_[0]; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select p_time_am from parts where p_id = '$part'"); db_disconnect($DBH); return $res[0][0]; } sub update_duration(@) { my ($part, $duration) = @_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_exec($DBH, "update parts set p_time = '$duration' where p_id = '$part'"); db_disconnect($DBH); } sub update_duration_am(@) { my ($part, $duration) = @_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_exec($DBH, "update parts set p_time_am = '$duration' where p_id = '$part'"); db_disconnect($DBH); } sub select_distance($) { my $part = $_[0]; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select p_distance from parts where p_id = '$part'"); db_disconnect($DBH); return $res[0][0]; } sub select_activity_distance($) { my $act = $_[0]; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select a_distance from activities where a_activity = '$act'"); db_disconnect($DBH); return $res[0][0]; } sub select_distance_am($) { my $part = $_[0]; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select p_distance_am from parts where p_id = '$part'"); db_disconnect($DBH); return $res[0][0]; } sub update_distance(@) { my ($part, $distance) = @_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_exec($DBH, "update parts set p_distance = '$distance' where p_id = '$part'"); db_disconnect($DBH); } sub update_distance_am(@) { my ($part, $distance) = @_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_exec($DBH, "update parts set p_distance_am = '$distance' where p_id = '$part'"); db_disconnect($DBH); } sub update_date_am(@) { my ($part, $distance) = @_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_exec($DBH, "update parts set p_date_am = '$distance' where p_id = '$part'"); db_disconnect($DBH); } sub exist_setname ($) { my ($set) = @_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select count(*) from sets where s_name = '$set'"); db_disconnect($DBH); return $res[0][0]; } sub parts_of_setname ($) { my $set = $_[0]; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select ps_part from setparts inner join sets on ps_set = s_id where s_name = '$set'"); db_disconnect($DBH); foreach my $line (@res) { push @parts, $line->[0]; } return @parts; } sub parts_of_setid ($) { my $set = $_[0]; my @parts; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select ps_part from setparts where ps_set = '$set'"); db_disconnect($DBH); foreach my $line (@res) { push @parts, $line->[0]; } return @parts; } sub add_to_parts (@) { my ($activity, $set, $dist, $dura, $shortname, $datum, $hm) = @_; if (exist_setname("$set")) { if (track_not_in_db($activity)) { my @parts = parts_of_setname ("$set"); if (@parts == 0) { print "Set ($set) bei Aktivität '$shortname' mit ID ($activity) ohne Teile!\n"; print "Um Strecke ($dist) und Zeit ($dura)zu Teilen hinzuzufügen müssen Teile angegeben werden\n\n"; show_part_short(); print "\nKommaseparierte Liste aller Parts eingeben bspw 1,2,3 :"; my $partl=; chomp $partl; @parts = split /,/, $partl; } foreach my $part (@parts) { # dauer aufaddieren my $altduration = select_duration ($part); my $newduration = $altduration + $dura; update_duration($part, $newduration); $altduration = select_duration_am ($part); $newduration = $altduration + $dura; update_duration_am($part, $newduration); # distanz aufaddieren my $altdistance = select_distance ($part); my $newdistance = $altdistance + $dist; update_distance($part, $newdistance); $altdistance = select_distance_am ($part); $newdistance = $altdistance + $dist; update_distance_am($part, $newdistance); update_partlastused($part,$datum); add_activities_parts($activity,$part); } update_setlastused($set,$datum); add_track_id_to_db($activity,$set,$shortname,$dist,$dura,$datum,$hm); } } } sub add_activities_parts(@) { my ($activity,$part) = @_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); db_exec($DBH, "insert into activities_parts set ap_activity='$activity', ap_part_id='$part'"); db_disconnect($DBH); } sub del_activities_parts(@) { my ($activity,$part) = @_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); db_exec($DBH, "delete from activities_parts where ap_activity='$activity' and ap_part_id='$part'"); db_disconnect($DBH); } sub update_setlastused(@) { my ($set,$date) = @_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_exec($DBH, "update sets set s_last='$date' where s_name = '$set'"); db_disconnect($DBH); } sub update_partlastused(@) { my ($part,$date) = @_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_exec($DBH, "update parts set p_last='$date' where p_id = '$part'"); db_disconnect($DBH); } sub conv_s_hms ($) { my $seconds = shift; $seconds = 0 if (!$seconds); my $hours = int( $seconds / (60*60) ); my $mins = ( $seconds / 60 ) % 60; my $secs = $seconds % 60; return sprintf("%02d:%02d:%02d", $hours,$mins,$secs) if ($seconds > 0); return '' if ($seconds eq ""); } sub date_str () { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $year+=1900; $mon++; my $str = sprintf ("%4d-%02d-%02s %02d:%02d:%02d", $year, $mon, $mday, $hour, $min, '00'); return $str; } sub conv_m_km ($) { my $meter = shift; $meter = 0 if (!$meter); return sprintf("%.2f", $meter/1000) if ($meter > 0); return '' if ($meter eq ""); } sub addmaintenance ($) { show_part_short(); print "\nTeile ID angeben für Wartung:"; my $id = ; chomp $id; if ($id ne "") { my $date = date_str(); my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); # zeitstempel für wartung an teil db_exec($DBH, "update parts set p_date_am = '$date' where p_id = '$id'"); # lese infos aus teil my $sql = "select p_id, p_name, p_text, p_t_id, p_time, p_max_time, p_distance, p_max_distance, p_start_date, p_end_date, p_inactive, p_date_am, p_time_am, p_distance_am from parts where p_id = '$id'"; #debug ("addmaintenance", $sql, $debug); # schreibe die infos aus teil in wartung my @res = db_select($DBH, "$sql"); my $cost = prompt ('Was hat das gekostet? ', -def=>'0', -integer=>'positive'); $sql = "INSERT INTO maintenance set p_id='$res[0][0]', p_name='$res[0][1]', p_text='$res[0][2]', p_t_id='$res[0][3]', p_time='$res[0][4]', p_max_time='$res[0][5]', p_distance='$res[0][6]', p_max_distance='$res[0][7]', p_start_date='$res[0][8]', p_end_date='$res[0][9]', p_inactive='$res[0][10]', p_date_am='$res[0][11]', p_time_am='$res[0][12]', p_distance_am='$res[0][13]', m_cost='$cost'"; #debug ("addmaintenance", $sql, $debug); # distanz, dauer und startdatum von teil zurücksetzen db_exec($DBH, "$sql"); # intervall strecke und zeit auf 0 db_exec($DBH, "update parts set p_time_am = '0', p_distance_am = '0' where p_id = '$id'"); db_disconnect($DBH); } } sub addtrack ($) { my @zip_files = get_zip_files($conf{INPUT}); my $done = 0; foreach my $zip_file (@zip_files) { $done = 1; print "."; # json file aus zip file entpacken und namen zurück liefern my $json_file = get_json_file($zip_file); # json file lesen und id, name, strecke und dauer entnehmen my ($activity,$name,$distance,$duration,$datum,$hm) = get_values_from_json($json_file); # zuordnung zu teilen anhand namens my ($shortname, $set) = $name =~ /^(.*)_(.*)_.*$/; add_to_parts ($activity, $set, $distance, $duration, $shortname, $datum, $hm); # dieses json wieder löschen und mit dem nächsten zip file weitermachen `rm *.json`; } if ($done) { print "\nFertig\n"; } else { print "Nichts zu tun\n"; } } sub deltrack ($) { printf "Zeige Aktivitäten...\n"; showtrack(); my $activity = prompt ('Welche ID soll entfernt werden? ', -text); # aktivität bekannt, set, distance, duration lesen my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select a_set, a_distance, a_duration from activities where a_activity = '$activity'"); my ($set, $distance, $duration) = ($res[0][0],$res[0][1],$res[0][2]); my @parts; # wenn set manual, part_ids einlesen if ($set eq "manual") { show_part_short(); print "\nManuelle Aktivität. Angabe der Teile notwendig.\n"; print "Kommaseparierte Liste aller Parts eingeben bspw 1,2,3 :"; my $partl=; chomp $partl; @parts = split /,/, $partl; } else { # sonst part_id aus db holen my @res = db_select($DBH, "select p_id, p_name from parts inner join setparts on p_id = ps_part inner join sets on s_id = ps_set where s_name = '$set'"); foreach my $p (@res) { push @parts, $p->[0]; } } # aktivität löschen, danach letztes verwendungsdatum dieses sets holen print "Lösche Aktivität\n"; db_exec($DBH, "delete from activities where a_activity = '$activity'"); my $lastdate = get_last_date_for_setname ($set); # dieses datum muss in s_last und p_last(s) ! update_setlastused ($set, $lastdate); my $partlist=join ', ', @parts; print "Aktualisiere Strecke und Distanz der Teile ($partlist)\n"; foreach my $part (@parts) { #print "$part\n"; # distance und duration von teil holen my @res = db_select($DBH, "select p_distance, p_time, p_distance_am, p_time_am from parts where p_id = '$part'"); my ($old_distance, $old_duration, $old_distance_am, $old_duration_am) = ($res[0][0],$res[0][1],$res[0][2],$res[0][3]); my $new_distance = $old_distance - $distance; my $new_duration = $old_duration - $duration; update_distance($part, $new_distance); update_duration($part, $new_duration); $new_distance = $old_distance_am - $distance; $new_duration = $old_duration_am - $duration; update_distance_am($part, $new_distance); update_duration_am($part, $new_duration); update_partlastused ($part, $lastdate); #besser wäre aus der tabelle alle einträge zu entfernen mit der aktivität del_activities_parts($activity,$part); } db_disconnect($DBH); } # funktion holt zu einem setnamen den Zeitpunkt der letzten verwendung sub get_last_date_for_setname ($) { my $set = $_[0]; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select a_date from activities WHERE a_set='$set' order by a_id DESC limit 1"); db_disconnect($DBH); return $res[0][0]; } sub get_setname_from_act ($) { my $actid = $_[0]; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select a_name from activities where a_id = '$actid'"); db_disconnect($DBH); return $res[0][0]; } sub get_date_from_act ($) { my $actid = $_[0]; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select a_date from activities where a_activity = '$actid'"); db_disconnect($DBH); return $res[0][0]; } sub editpart () { printf "Zeige Teile...\n"; show_part_short(); my $part = prompt ('Welches Teil soll bearbeitet werden? ', -integer); given (prompt -k1, "Was soll geändert werden? all(g)emeines, [W]erte eingeben oder aus (A)ktivität", -keyletters) { when (/G/i) { edit_part_str ($part); } when (/A/i) { edit_part_akt ($part); } when (/W/i) { edit_part_val ($part); } default { edit_part_val ($part); } } } sub addset () { my $s_name = ""; my $s_text = ""; my $s_inactive = 0; print ("Übersicht der vorhandenen Sets\n"); show_set_short(); $s_name = prompt ('Wie soll das Set heißen? ', -text); $s_text = prompt ('Beschreibung? ', -text); given (prompt -k1, "Set [A]ctive or (I)nactive? ", -keyletters) { when (/i/i) { $s_inactive = 1; } } my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); db_exec($DBH, "insert into sets set s_name='$s_name', s_text='$s_text', s_inactive=$s_inactive"); db_disconnect($DBH); } sub delset () { show_set_short(); my $set = prompt ('Welches Set soll entfernt werden (ID)? ', -integer); my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); # zunächst set aus zuordnung zu teilen löschen db_exec($DBH, "delete from setparts where ps_set = '$set'"); # dann set löschen db_exec($DBH, "delete from sets where s_id = '$set'"); db_disconnect($DBH); } sub addtype () { my $t_name = ""; my $t_text = ""; my $t_inactive = 0; print ("Übersicht der vorhandenen Typen\n"); showtype (); $t_name = prompt ('Wie soll der Typ heißen? ', -text); $t_text = prompt ('Beschreibung? ', -text); given (prompt -k1, "Typ [A]ctive or (I)nactive? ", -keyletters) { when (/i/i) { $t_inactive = 1; } } my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); db_exec($DBH, "insert into types set t_name='$t_name', t_text='$t_text', t_inactive=$t_inactive"); db_disconnect($DBH); } sub deltype () { showtype (); my $t_id = prompt ('Welcher Typ soll entfernt werden (ID)? ', -integer); my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); #select p_id,p_name from parts where p_t_id = 14 #db_exec($DBH, "delete from sets where s_id = '$set'"); my @res = db_select($DBH, "select p_id, p_name from parts where p_t_id='$t_id'"); if (@res == 0) { print "\nTyp nicht in Verwendung, wird entfernt.\n"; db_exec($DBH, "delete from types where t_id = '$t_id'"); } else { my (@header,@rows,@row); foreach my $line (@res) { @row = [ "${$line}[0]", "${$line}[1]" ]; push @rows, @row; } @header=[ "Teile ID", "Name" ]; print "\nTyp hier in Verwendung, wird nicht entfernt.\n"; table_short (\@header, \@rows); } # db_disconnect($DBH); } sub addpart () { my $p_name = ""; my $p_text = ""; my $p_inactive = 0; my $p_t_id; my $p_max_time; my $p_max_distance; my $p_start_date; my $p_end_date; print ("Übersicht der vorhandenen Teile\n"); show_part_short (); $p_name = prompt ('Wie soll das Teil heißen? ', -text); $p_text = prompt ('Beschreibung? ', -text); given (prompt -k1, "Teil [A]ctive or (I)nactive? ", -keyletters) { when (/i/i) { $p_inactive = 1; } } showtype (); $p_t_id = prompt ('Welchen Typ soll das Teil haben (ID)? ', -integer); my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); db_exec($DBH, "insert into parts set p_name='$p_name', p_text='$p_text', p_inactive=$p_inactive, p_t_id=$p_t_id"); db_disconnect($DBH); } sub delpart () { show_part_short(); my $part = prompt ('Welches Teil soll entfernt werden (ID)? ', -integer); my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); # zunächst teil aus zuordnung zu sets löschen db_exec($DBH, "delete from setparts where ps_part = $part"); # dann teil löschen db_exec($DBH, "delete from parts where p_id = $part"); db_disconnect($DBH); } sub edit_part_str ($) { } sub edit_part_akt ($) { my ($part)=@_; show_onepart_short ($part); my $d = select_distance($part); my $dam = select_distance_am($part); my $h = select_duration($part); my $ham = select_duration_am($part); showtrack(); my $activity = prompt ('Welche ID soll genutzt werden? ', -text); # distance und duration aus aktivität lesen my $actd = select_activity_distance($activity); my $acth = select_activity_duration($activity); my $action = prompt ('Werte addieren (+) oder abziehen (-)', -1, -guarantee=>qr/[\+-]/); my $actstr="addieren aufs"; $actstr="abziehen vom" if ($action eq "-"); my ($newd,$newdam,$newh,$newham); if ($action eq "+") { $newd = $d + $actd; $newh = $h + $acth; $newdam = $dam + $actd; $newham = $ham + $acth; } if ($action eq "-") { $newd = $d - $actd; $newh = $h - $acth; $newdam = $dam - $actd; $newham = $ham - $acth; } # } #} print "\nAktivitäten anzeigen. Auswahl bei welcher das Teil zuletzt benutzt wurde.\n"; showtrack(); my $oldactivity = prompt ('Bei welcher Aktivität wurde das Teil zuletzt benutzt? ', -text); my $actdate=get_date_from_act($oldactivity); update_partlastused($part, $actdate); update_distance($part,$newd); update_distance_am($part,$newdam); update_duration($part,$newh); update_duration_am($part,$newham); } sub edit_part_val ($) { my ($part)=@_; show_onepart_short ($part); my $d = select_distance($part); my $dam = select_distance_am($part); my $h = select_duration($part); my $ham = select_duration_am($part); # überschreiben, aus aktivität, delta print "\nEs gibt 3 Möglichkeiten die Werte zu verändern Mit Vorzeichen = wird der Wert auf den eingegebenen gesetzt, der alte also überschrieben Mit Vorzeichen + wird der eingegebene auf den alten aufsummiert Mit Vorzeichen - wird der eingegebene vom alten abgezogen\n"; printf "\n%10s %-15s\n", "Wert", "(aktuell)"; my ($s,$nd,$ndam,$nh,$nham,$ndate); $s = sprintf "%10s (%-15f): \n", "meter ges", $d; $nd = prompt "$s", -def=>'+0', -guarantee=>qr/[=\+\.0-9-]/; $nd = calc_new ($d,$nd); $s = sprintf "%10s (%-15f): \n", "meter int", $dam; $ndam = prompt "$s", -def=>'+0', -guarantee=>qr/[=\+\.0-9-]/; $ndam = calc_new ($dam,$ndam); $s = sprintf "%10s (%-15f): \n", "sek ges", $h; $nh = prompt "$s", -def=>'+0', -guarantee=>qr/[=\+\.0-9-]/; $nh = calc_new ($h,$nh); $s = sprintf "%10s (%-15f): \n", "sek int", $ham; $nham = prompt "$s", -def=>'+0', -guarantee=>qr/[=\+\.0-9-]/; $nham = calc_new ($ham,$nham); $ndate = prompt "\nWelches Datum als letzte Verwendung setzen? (yyyy-mm-dd hh:mm:ss): ", -def=>'==', -text; update_partlastused($part,$ndate) if ($ndate ne '=='); update_distance($part,$nd); update_distance_am($part,$ndam); update_duration($part,$nh); update_duration_am($part,$nham); } sub editset () { printf "Zeige Sets...\n"; show_set_short(); my $set = prompt ('Welches Set soll bearbeitet werden? ', -integer); given (prompt -k1, "Was soll geändert werden? all(g)emeines, [Z]uordnung der Teile:", -keyletters) { when (/G/i) { edit_set_str ($set); } when (/Z/i) { edit_set_parts ($set); } default { edit_set_parts ($set); } } } sub edit_set_str ($) { } sub edit_set_parts ($) { my ($set)=@_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select ps_part, p_name, p_text from setparts inner join parts on ps_part=p_id where ps_set=$set"); my (@header,@rows,@row); foreach my $line (@res) { @row = [ "${$line}[0]", "${$line}[1]", "${$line}[2]" ]; push @rows, @row; } @header=[ "Teil", "Name", "Beschreibung" ]; print "\nAktuelle Zuordnung\n"; table_short (\@header, \@rows); print "\nAlle Teile\n"; show_part_short(); my $part = prompt "Teil zu Set hinzufügen mit +Nr, von Set entfernen mit -Nr: ", -guarantee=>qr/[\+0-9-]/; if ($part =~ /^\+/) { my ($p)=$part=~/\+([0-9]*)/; print "$p zu set hinzufügen\n"; db_exec($DBH, "insert into setparts set ps_part=$p, ps_set=$set"); } elsif ($part =~ /^-/) { my ($p)=$part=~/-([0-9]*)/; print "$p aus set entfernen\n"; db_exec($DBH, "delete from setparts where ps_part=$p and ps_set=$set"); } else { print "ungültige Eingabe\n"; } db_disconnect($DBH); } sub calc_new ($) { my ($o,$d)=@_; my $n; my $v; if ($d=~/^[\+=-]{1}[0-9\.]*$/) { if ($d=~/^=/) { ($v)=$d=~/=([0-9\.]*)/; $n=$v; } if ($d=~/^\+/) { ($v)=$d=~/\+([0-9\.]*)/; $n=$o + $v; } if ($d=~/^-/) { ($v)=$d=~/-([0-9\.]*)/; $n=$o - $v; } } else { #print "Fehleingabe. Wert bleibt unverändert\n"; $n=$o; } return $n; } sub replacepart () { printf "Zeige Teile...\n"; show_part_short(); my $parto = prompt ('Welches Teil soll ersetzt werden? ', -integer); my $partn = prompt ('Welches Teil soll ersetzen? ', -integer); my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_exec($DBH, "update setparts SET ps_part = '$partn' where ps_part = '$parto'"); db_disconnect($DBH); } sub showtype ($) { my $where = ""; $where = " where t_inactive = '0'" if ($_[0] eq "active"); $where = " where t_inactive = '1'" if ($_[0] eq "inactive"); my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select t_id, t_inactive, t_name,t_text from types $where"); db_disconnect($DBH); my (@header,@rows,@row); foreach my $line (@res) { my $status = ""; # $status = "I" if (${$line}[1] == 1); @row = [ "${$line}[0]", "$status", "${$line}[2]", "${$line}[3]" ]; push @rows, @row; } @header=[ "ID", "A", "Name", "Beschreibung" ]; table_short (\@header, \@rows); } sub showpart ($) { my $where = ""; $where = " where p_inactive = '0'" if ($_[0] eq "active"); $where = " where p_inactive = '1'" if ($_[0] eq "inactive"); my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select p_id, p_inactive, p_name, p_text, p_distance, p_max_distance, p_time, p_max_time, p_start_date, p_end_date, t_name, p_last, p_distance_am, p_time_am from parts inner join types on p_t_id = t_id $where"); my (@header,@rows,@row); foreach my $line (@res) { my $str = '%' . "${$line}[0]" . ',%'; #select ps_set,ps_part,s_name from setparts inner join sets on ps_set = s_id inner join parts on ps_part=p_id where p_id = ${$line}[0] #my @res2=db_select($DBH, "select s_name from sets where s_p_ids like '$str'"); my @res2=db_select($DBH, "select s_name from setparts inner join sets on ps_set = s_id inner join parts on ps_part=p_id where p_id = ${$line}[0]"); my $sets; foreach my $lres2 (@res2) { $sets .= ${$lres2}[0] . "\n"; } my $status = ""; # $status = "I" if (${$line}[1] == 1); my $use1=${$line}[8]; $use1='' if (!$use1); my $use2=${$line}[9]; $use2='' if (!$use2); my $use3=${$line}[11]; $use3='' if ($use3 =~ /0000/); my $var1=conv_m_km(${$line}[4]); my $var2=conv_s_hms(${$line}[6]); my $var3=conv_m_km(${$line}[5]); my $var4=conv_s_hms(${$line}[7]); my $kam=conv_m_km(${$line}[12]); my $tam=conv_s_hms(${$line}[13]); @row = [ "${$line}[0]", "$status", "${$line}[2]\nDistanz (km)\nDauer (h:m:s)\nNutzung seit\n \" bis\n \" letzte", "${$line}[3]\n$var1 ($kam)\n$var2 ($tam)\n$use1\n$use2\n$use3", "${$line}[10]\n$var3\n$var4", "$sets" ]; push @rows, @row; } @header=["ID", "A", "Name", "Beschreibung\nist/ist/seit\nges (int)", "Typ\nmax/max/bis", "Enthalten\nin Sets" ]; table (\@header, \@rows); db_disconnect($DBH); } sub showset ($) { my $where = ""; $where = " where s_inactive = '0'" if ($_[0] eq "active"); $where = " where s_inactive = '1'" if ($_[0] eq "inactive"); my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); #my @res = db_select($DBH, "select s_id, s_inactive, s_name, s_text, s_p_ids from sets $where"); my @res = db_select($DBH, "select s_id, s_inactive, s_name, s_text from sets $where order by s_name"); # sets my (@header,@rows,@row); foreach my $line (@res) { my $status = ""; # $status = "I" if (${$line}[1] == 1); @row = [ "${$line}[0]", "$status", "${$line}[2]", "${$line}[3]" ]; push @rows, @row; # die namen der teile und namen der typen holen #my @parts = split ",", ${$line}[4]; #my @parts = db_select($DBH, "select ps_part from setparts where ps_set = ${$line}[0]"); #my @parts = db_select($DBH, "select ps_part from setparts inner join parts on ps_part=p_id where ps_set = ${$line}[0] order by p_name"); my @parts = db_select($DBH, "select ps_part from setparts inner join parts on ps_part=p_id inner join types on p_t_id=t_id where ps_set = ${$line}[0] order by t_name,p_name"); foreach my $part (@parts) { my @res2 = db_select($DBH, "select p_name, t_name, p_distance, p_time, p_distance_am, p_time_am from parts inner join types on p_t_id = t_id where p_id = '${$part}[0]'"); #my @res2 = db_select($DBH, "select p_name, t_name, p_distance, p_time from parts inner join types on p_t_id = t_id where p_id = '$part'"); my $var1=conv_m_km($res2[0][2]); my $var2=conv_s_hms($res2[0][3]); my $var3=conv_m_km($res2[0][4]); my $var4=conv_s_hms($res2[0][5]); @row = [ "", "", " $res2[0][0]", " $res2[0][1]", "$var1 ($var3)", "$var2 ($var4)" ]; push @rows, @row; } @row = [ "", "", "", "", "", "" ]; push @rows, @row; } @header=["ID", "A", "Name\n Teil/Teil/...", "Beschreibung\n Typ/Typ/...", "Nutzung km\nges (int)", "Nutzung h:m:s\nges (int)" ]; table_short (\@header, \@rows); db_disconnect($DBH); } sub showtrack ($) { debug("showtrack", "start", $debug); my $anz = prompt ("\nAnzahl der Aktivitäten (0 für alle):", -integer, -must => { 'be in range' => [0..999] }); my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my $sql; if ($anz == 0) { $sql = "select a_name, a_activity, a_set, a_distance, a_duration, a_date from activities order by a_id desc"; } else { $sql = "select a_name, a_activity, a_set, a_distance, a_duration, a_date from activities order by a_id desc limit $anz"; } my @res = db_select($DBH, "$sql"); db_disconnect($DBH); my (@header,@rows,@row); foreach my $l (@res) { my $val1 = conv_s_hms(${$l}[4]); my $val2 = conv_m_km(${$l}[3]); @row = [ "${$l}[5]\n${$l}[0]", "${$l}[1]\n${$l}[2]", "$val1\n$val2" ]; push @rows, @row; } @header=["Datum\nName", "ID\nSet", "Dauer (h:m:s)\nkm (ist)"]; table (\@header, \@rows); } sub showmaintenance ($) { show_part_short (); my $part = prompt ('Teil wählen (0 für alle):', -integer, -must => { 'be in range' => [0..999] }); my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my $sql; if ($part == 0) { $sql = "select m_date, p_name, p_text, p_time, p_max_time, p_distance, p_max_distance, p_start_date, p_end_date, m_cost from maintenance order by m_id asc"; } else { $sql = "select m_date, p_name, p_text, p_time, p_max_time, p_distance, p_max_distance, p_start_date, p_end_date, m_cost from maintenance where p_id = '$part' order by m_id asc"; } my @res = db_select($DBH, "$sql"); db_disconnect($DBH); my (@header,@rows,@row); foreach my $l (@res) { my $val1=conv_s_hms(${$l}[3]); my $val2=conv_m_km(${$l}[5]); my $val3=conv_s_hms(${$l}[4]); my $val4=conv_m_km(${$l}[6]); @row = [ "${$l}[0]", "${$l}[1]\n${$l}[2]", "$val1\n$val2", "$val3\n$val4", "${$l}[7]\n${$l}[8]" , "${$l}[9]"]; push @rows, @row; } @header=["Datum", "Name\nBeschreibung", "h:m:s (ist)\nkm (ist)", "h:m:s (max)\nkm (max)", "seit\nbis (max)", "Kosten"] ; table (\@header, \@rows); } sub show_part_short () { my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select p_id, p_name, p_text, p_distance, p_max_distance, p_time, p_max_time, p_start_date, p_end_date, t_name from parts inner join types on p_t_id = t_id where p_inactive='0'"); db_disconnect($DBH); my (@header,@rows,@row); foreach my $line (@res) { @row = [ "${$line}[0]", "${$line}[1]", "${$line}[2]" ]; push @rows, @row; } @header=["ID", "Name", "Beschreibung" ]; table_short (\@header, \@rows); } sub show_set_short () { my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select s_id, s_name from sets"); db_disconnect($DBH); my (@header,@rows,@row); foreach my $line (@res) { @row = [ "${$line}[0]", "${$line}[1]" ]; push @rows, @row; } @header=["ID", "Name" ]; table_short (\@header, \@rows); } #sub show_activity_short () { # my $DBH; # db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); # # my @res = db_select($DBH, "select a_set, a_name, a_activity, a_date from activities"); # db_disconnect($DBH); # # my (@header,@rows,@row); # foreach my $line (@res) { # @row = [ "${$line}[0]", "${$line}[1]", "${$line}[2]", "${$line}[3]" ]; # push @rows, @row; # } # @header=["Set", "Name", "ID", "Datum" ]; # table_short (\@header, \@rows); #} sub show_onepart_short ($) { my ($part)=@_; my $DBH; db_connect($DBH, $conf{'DB_TYPE'}, $conf{'DB_NAME'}, $conf{'DB_HOST'}, $conf{'DB_PORT'}, $conf{'DB_USER'}, $conf{'DB_PASS'}); my @res = db_select($DBH, "select p_name, p_distance, p_time, p_distance_am, p_time_am, p_last from parts where p_id = $part"); db_disconnect($DBH); my (@header,@rows,@row); foreach my $line (@res) { my $v1=${$line}[1]; $v1=conv_m_km($v1); my $v2=${$line}[2]; $v2=conv_s_hms($v2); my $v3=${$line}[3]; $v3=conv_m_km($v3); my $v4=${$line}[4]; $v4=conv_s_hms($v4); @row = [ "${$line}[0]\n${$line}[5]\n", "\n${$line}[1]\n$v1", "\n${$line}[2]\n$v2", "\n${$line}[3]\n$v3", "\n${$line}[4]\n$v4" ]; push @rows, @row; } @header=["Name\nletzte Verwendung", "ges m\n km", "ges h\n h:m:s", "int m\n km", "int h\n h:m:s" ]; table_short (\@header, \@rows); } sub db_connect (@) { my $ok = eval { $_[0] = DBI->connect("DBI:$_[1]:$_[2]:$_[3]:$_[4]", "$_[5]", "$_[6]"); return 0 if (!$_[0]); return 1; }; return $ok; } sub db_disconnect (@) { $_[0]->disconnect(); } sub db_exec (@) { $FUNC_STATEMENT_HANDLE = $_[0]->prepare ("$_[1]"); $FUNC_STATEMENT_HANDLE->execute(); $FUNC_STATEMENT_HANDLE->finish(); } sub db_select (@) { my @data; my $i; my $j; my @ret; $FUNC_STATEMENT_HANDLE = $_[0]->prepare ("$_[1]"); $FUNC_STATEMENT_HANDLE->execute(); $i=0; while (@data = $FUNC_STATEMENT_HANDLE->fetchrow_array()) { $j=0; foreach (@data) { $ret[$i][$j]=$_; $j++; } $i++; } return @ret; } sub read_config { my $configfile=shift; my $vd=':'; # trennt var von wert my $ad=';'; # trennt werte im array bzw. wertpaare im hash my $hd='#'; # trennt wert von key im hash open CF,"$configfile"; foreach () { chomp; if ($_ =~ /require/) { my ($f) = $_ =~ /require "(.*)"/; read_config($f); } else { my ($k,$v) = split /$vd/,$_; # trennung zwischen var-name und werten if ($k =~ /^@/) { # array variable my @val=split /$ad/,$v; foreach (@val) { push @{$conf{"$k"}},$_; } } if ($k =~ /^%/) { # hash variable my @val=split /$ad/,$v; foreach my $vp (@val) { my ($k1,$v1) = split /$hd/,$vp; $conf{"$k"}{"$k1"}=$v1; } } else { $conf{"$k"} = $v; } } } close CF; } ######## Allgemeine Funktionen und Beispielnutzung sub exit_on_error { # call: exit_on_error("text"); my $m=shift; print "\n\n ### $m\n\n\n"; exit 1; } sub p { # call p("text"); my $m = shift; printf "$m\n"; } sub clrscr { # call clrscr(); Leert Bildschirminhalt for (0..50) { print "\n"; } } sub discard_error_msg { my $d=shift; if ($d==1) { open STDERR, '>/dev/null'; } else { close STDERR; } } sub remove_doubles { # call my @arr=qw /a2 a2 a2 a2 a2 a2 a2 b3 b3 b3 b3/; # @arr=remove_doubles(\@arr); my $o=shift; my @o=@{$o}; my %h; foreach (@o) { next if ($h{$_}); $h{$_}=1; } @o=(); foreach (keys %h) { push @o, $_; } return @o; } sub debug { $_[2] = 0 if (!$_[2]); printf "%-10s : %s\n", $_[0], $_[1] if ($_[2] == 1); } sub table (@) { my ($head, $rows) = @_; my $at = Term::ANSITable->new( columns => @{$head} ); foreach my $row(@{$rows}) { $at = $at->add_row($row); } #$at->{_table}->{cell_vpad} = 0; $at->{_table}->{show_row_separator} = 1; $at->refresh_table->draw(); } sub table_short (@) { my ($head, $rows) = @_; my $at = Term::ANSITable->new( columns => @{$head} ); foreach my $row(@{$rows}) { $at = $at->add_row($row); } #$at->{_table}->{cell_vpad} = 0; $at->{_table}->{show_row_separator} = 0; $at->refresh_table->draw(); } sub print_help () { print ' Der BikePartTracker holt sich aus den gepackten Garmin Aktivitäten Infos über Aufzeichnungen. Aus dem Namen der Aktivität wird das verwendete Set ermittelt. Dauer und Strecke werden auf alle Teile des Sets aufaddiert. Weitere Funktionen sind/werden Verwaltung von Typen, Teilen, Sets und Aufzeichnungen. Von den Aufzeichnungen werden nur Übersichtsdaten gelesen (Name, ID, Dauer, Strecke, Datum) '; exit 1; } 1;