summaryrefslogtreecommitdiffstats
path: root/scripts/mytop.sh
blob: 65bfb8c976e201ee03110b3660f06515e224a1f9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
#!/usr/bin/env perl
#
# $Id: mytop,v 1.99-maria6 2019/10/22 14:53:51 jweisbuch Exp $

=pod

=head1 NAME

mytop - display MariaDB/MySQL server performance info like `top'

=cut

## most of the POD is at the bottom of the file

use 5.005;
use strict;
use warnings;
use DBI;
use Getopt::Long;
use Socket;
use List::Util qw(min max);
use File::Basename;

$main::VERSION = "1.99-maria6";
my $path_for_script = dirname($0);

$| = 1;
$0 = 'mytop';

my $WIN = ($^O eq 'MSWin32') ? 1 : 0;

## Test for color support.

eval { require Term::ANSIColor; };

my $HAS_COLOR = $@ ? 0 : 1;

$HAS_COLOR = 0 if $WIN;

## Test of Time::HiRes support

eval { require Time::HiRes };

my $HAS_TIME = $@ ? 0 : 1;

my $debug = 0;

## Try to lower our priority (which, who, pri)

setpriority(0,0,10) unless $WIN;

## Prototypes

sub Clear();
sub GetData();
sub GetQPS();
sub FullQueryInfo($);
sub Explain($);
sub PrintTable(@);
sub PrintHelp();
sub Sum(@);
sub commify($);
sub make_short($);
sub Hashes($);
sub Execute($);
sub StringOrRegex($);
sub GetInnoDBStatus();
sub GetCmdSummary();
sub GetShowVariables();
sub GetShowStatus();
sub cmd_s;
sub cmd_S;
sub cmd_q;

## Default Config Values

my %config = (
    batchmode     => 0,
    color         => 1,
    db            => '',
    database      => '',
    delay         => 5,
    filter_user   => qr/.?/,
    filter_db     => qr/.?/,
    filter_host   => qr/.?/,
    filter_state  => qr/.?/,
    header        => 1,
    help          => 0,
    host          => 'localhost',
    idle          => 1,
    long          => 120,
    long_nums     => 0,
    mode          => 'top',
    prompt        => 0,
    pass          => '',
    password      => '',
    port          => 3306,
    resolve       => 0,
    slow          => 10,        ## slow query time
    socket        => '',
    sort          => 1,         ## default or reverse sort ("s")
    user          => 'root',
    fullqueries   => 0,         ## shows untruncated queries
    usercol_width => 8,         ## User column width
    dbcol_width   => 9,         ## DB column width
    hide_progress => 0          ## hide the "%" column when available
);

my %qcache = ();    ## The query cache--used for full query info support.
my %ucache = ();    ## The user cache--used for full killing by user
my %dbcache = ();   ## The db cache.  This should be merged at some point.
my %statcache = (); ## The show status cache for GetShowStatus()

my (%STATUS, %OLD_STATUS); # header stuff.

my $CLEAR = $WIN ? '': `clear`;

## Term::ReadKey values

my $RM_RESET   = 0;
my $RM_NOBLKRD = 3; ## using 4 traps Ctrl-C :-(

## Add options from .my.cnf first

my $my_print_defaults;
if (!defined($my_print_defaults=my_which("my_print_defaults")))
{
  print "Warning: Can't find my_print_defaults. Please add it to your PATH!\n";
  exit(1);
}

unshift @ARGV, split "\n", `$my_print_defaults client mytop`;

## Read the user's config file, if it exists.

my $config = "$ENV{HOME}/.mytop";

if (-e $config)
{
    if (open CFG, "<$config")
    {
        while (<CFG>)
        {
            next if /^\s*($|#)/;  ## skip blanks and comments

            chomp;

            if (/(\S+)\s*=\s*(.*\S)/)
            {
                $config{lc $1} = $2 if exists $config{lc $1};
            }
        }
        close CFG;
    }
    ## map database/password onto db/pass
    ## short version gets precedence for historical reasons
    $config{'db'} = $config{'database'} unless $config{'db'};
    $config{'pass'} = $config{'password'} unless $config{'pass'};
}

## Command-line args.

use vars qw($opt_foo);

Getopt::Long::Configure('no_ignore_case', 'bundling');

GetOptions(
    "color!"              => \$config{color},
    "user|u=s"            => \$config{user},
    "pass|password|p=s"   => \$config{pass},
    "database|db|d=s"     => \$config{db},
    "host|h=s"            => \$config{host},
    "port|P=i"            => \$config{port},
    "socket|S=s"          => \$config{socket},
    "delay|s=i"           => \$config{delay},
    "batch|batchmode|b"   => \$config{batchmode},
    "header!"             => \$config{header},
    "idle|i!"             => \$config{idle},
    "resolve|r!"          => \$config{resolve},
    "prompt!"             => \$config{prompt},
    "long=i"              => \$config{long},
    "long_nums!"          => \$config{long_nums},
    "mode|m=s"            => \$config{mode},
    "slow=i"              => \$config{slow},
    "sort=s"              => \$config{sort},
    "fullqueries|L!"      => \$config{fullqueries},
    "usercol_width=i"     => \$config{usercol_width},
    "dbcol_width=i"       => \$config{dbcol_width},
    "hide_progress|a!"    => \$config{hide_progress}
);

## User may have put the port with the host.

if ($config{host} =~ s/:(\d+)$//)
{
    $config{port} = $1;
}

## Don't use Term::ReadKey unless running interactively.

if (not $config{batchmode})
{
    require Term::ReadKey;
    Term::ReadKey->import();
}

## User may want to disable color.

if ($HAS_COLOR and not $config{color})
{
    $HAS_COLOR = 0;
}

if ($HAS_COLOR)
{
    import Term::ANSIColor ':constants';
}
else
{
    *RESET  = sub { };
    *YELLOW = sub { };
    *RED    = sub { };
    *MAGENTA  = sub { };
    *GREEN  = sub { };
    *BLUE   = sub { };
    *WHITE  = sub { };
    *BOLD   = sub { };
}

my $RESET  = RESET()   || '';
my $YELLOW = YELLOW()  || '';
my $RED    = RED()     || '';
my $MAGENTA  = MAGENTA()   || '';
my $GREEN  = GREEN()   || '';
my $BLUE   = BLUE()    || '';
my $WHITE  = WHITE()   || '';
my $BOLD   = BOLD()    || '';

## Connect

my $dsn;

## Socket takes precedence.
my $prefix= 'mysql';
if (eval {DBI->install_driver("MariaDB")}) {
  $dsn = "DBI:MariaDB:database=$config{db};mariadb_read_default_group=mytop;";
  $prefix= 'mariadb'
} else {
  $dsn = "DBI:mysql:database=$config{db};mysql_read_default_group=mytop;";
}

if ($config{socket} and -S $config{socket})
{
  $dsn .= "${prefix}_socket=$config{socket}";
}
else
{
    $dsn .= "host=$config{host};port=$config{port}";
}

if ($config{prompt})
{
    print "Password: ";
    ReadMode(2);
    chomp($config{pass} = <STDIN>);
    ReadMode(0);
    print "\n";
}

my $dbh = DBI->connect($dsn, $config{user}, $config{pass},
                       { PrintError => 0 });

if (not ref $dbh)
{
    my $Error = <<EODIE
Cannot connect to MariaDB/MySQL server. Please check the:

  * database you specified "$config{db}" (default is "")
  * username you specified "$config{user}" (default is "root")
  * password you specified "$config{pass}" (default is "")
  * hostname you specified "$config{host}" (default is "localhost")
  * port you specified "$config{port}" (default is 3306)
  * socket you specified "$config{socket}" (default is "")

The options my be specified on the command-line or in a ~/.mytop or
~/.my.cnf config file. See the manual (perldoc mytop) for details.

Here's the exact error from DBI. It might help you debug:

$DBI::errstr

EODIE
;

    die $Error;

}

ReadMode($RM_RESET) unless $config{batchmode};

## Get static data

my $db_version;
my $db_release;
my $server = "MySQL";
my $have_query_cache;

my @variables = Hashes("SHOW VARIABLES");

foreach (@variables)
{
    if ($_->{Variable_name} eq "version")
    {
        $db_version = $_->{Value};
        $db_version =~ /^(\d+)/;
        $db_release = $1;
        $server = "MariaDB" if ($db_version =~ /maria/i);
        # Get the version number only
        $db_version = $1 if($db_version =~ m/(.*?)-/);
        next;
    }
    if ($_->{Variable_name} eq "have_query_cache")
    {
        if ($_->{Value} ne 'NO')
        {
            $have_query_cache = 1;
        }
        else
        {
            $have_query_cache = 0;
        }
        next;
    }
}

my ($has_is_processlist, $has_time_ms, $has_progress);
$has_is_processlist = $has_time_ms = $has_progress = 0;

## Check if the server has the INFORMATION_SCHEMA.PROCESSLIST table
## for backward compatibility
$has_is_processlist = Execute("SELECT /*mytop*/ 1 FROM INFORMATION_SCHEMA.TABLES
                               WHERE TABLE_SCHEMA = 'information_schema' AND
                               TABLE_NAME = 'PROCESSLIST';")->rows;
if ($has_is_processlist == 1)
{
    ## Check if the server has the TIME_MS column on the I_S.PROCESSLIST table
    ## If it is the case, it will fetch the query time with decimal precision
    ## for queries that has been running for less than 10k seconds
    $has_time_ms = Execute("SELECT /*mytop*/ 1 FROM INFORMATION_SCHEMA.COLUMNS
                            WHERE TABLE_SCHEMA = 'information_schema' AND
                            TABLE_NAME = 'PROCESSLIST' AND
                            COLUMN_NAME = 'TIME_MS';")->rows;
    if ($has_time_ms == 1)
    {
        ## Check if the server has the STAGE column on the I_S.PROCESSLIST
        ## table (MariaDB) to retreive query completion information
        $has_progress = Execute("SELECT /*mytop*/ 1 FROM INFORMATION_SCHEMA.COLUMNS
                                WHERE TABLE_SCHEMA = 'information_schema' AND
                                TABLE_NAME = 'PROCESSLIST' AND
                                COLUMN_NAME = 'STAGE';")->rows;
    }
}

#########################################################################
##
## The main loop
##
#########################################################################

ReadMode($RM_NOBLKRD)  unless $config{batchmode};

while (1)
{
    my $key;

    if ($config{mode} eq 'qps')
    {
        GetQPS();
        $key = ReadKey(1);

        next unless $key;

        if ($key =~ /t/i)
        {
            $config{mode} = 'top';
        }
        if ($key =~ /q/)
        {
            cmd_q();
        }
        next;
    }
    if ($config{mode} eq 'top')
    {
        GetData();
        last if $config{batchmode};
        $key = ReadKey($config{delay});
        next unless $key;
    }
    elsif ($config{mode} eq 'cmd')
    {
        GetCmdSummary();
        last if $config{batchmode};
        $key = ReadKey($config{delay});
        next unless $key;
    }
    elsif ($config{mode} eq 'innodb')
    {
        GetInnoDBStatus();
        last if $config{batchmode};
        print "InnoDB Status [hit t to exit this mode or q to exit the application]\n";
        $key = ReadKey($config{delay});
        next unless $key;
    }
    elsif ($config{mode} eq 'status')
    {
        GetShowStatus();
        last if $config{batchmode};
        $key = ReadKey($config{delay});
        next unless $key;
    }

    ##
    ## keystroke command processing (if we get this far)
    ##

    if ($key eq '!')
    {
        Execute("STOP /*mytop*/ SLAVE;");
        Execute("SET /*mytop*/ GLOBAL sql_slave_skip_counter=1");
        Execute("START /*mytop*/ SLAVE");
    }

    # t - top

    if ($key =~ /t/i)
    {
        $config{mode} = 'top';
    }

    ## q - quit

    if ($key eq 'q')
    {
        cmd_q();
    }

    if ($key eq 'D')
    {
        require Data::Dumper;
        print Data::Dumper::Dumper([\%config]);
        ReadKey(0);
    }

    ## l - change long running hightling

    if ($key eq 'l')
    {
        cmd_l();
        next;
    }

    ## m - mode switch to qps

    if ($key eq 'm')
    {
        $config{mode} = 'qps';
        Clear() unless $config{batchmode};
        print "Queries Per Second [hit t to exit this mode or q to exit the application]\n";
        next;
    }

    ## c - mode switch to command summary

    if ($key eq 'c')
    {
        $config{mode} = 'cmd';
        Clear() unless $config{batchmode};
        print "Command Summary\n";
        next;
    }

    ## C - change Color on and off

    if ($key eq 'C')
    {
        if ($HAS_COLOR)
        {
            $HAS_COLOR = 0;
        }
        else
        {
            $HAS_COLOR = 1;
        }
    }

    ## s - seconds of delay

    if ($key eq 's')
    {
        cmd_s();
        next;
    }

    if ($key eq 'S')
    {
        cmd_S();
        next;
    }

    ## R - resolve hostnames
    if ($key eq 'R')
    {
        if ($config{resolve})
        {
            $config{resolve} = 0;
        }
        else
        {
            $config{resolve} = 1;
        }
    }

    ## t - username based filter

    if ($key eq 't')
    {
        ReadMode($RM_RESET);
        print RED(), "Which state (blank for all, /.../ for regex): ", RESET();
        $config{filter_state} = StringOrRegex(ReadLine(0));
        ReadMode($RM_NOBLKRD);
        next;
    }

    ## u - username based filter

    if ($key eq 'u')
    {
        ReadMode($RM_RESET);
        print RED(), "Which user (blank for all, /.../ for regex): ", RESET();
        $config{filter_user} = StringOrRegex(ReadLine(0));
        ReadMode($RM_NOBLKRD);
        next;
    }

    ## d - database name based filter

    if ($key eq 'd')
    {
        ReadMode($RM_RESET);
        print RED(), "Which database (blank for all, /.../ for regex): ",
            RESET();
        $config{filter_db} = StringOrRegex(ReadLine(0));
        ReadMode($RM_NOBLKRD);
        next;
    }

    ## h - hostname based filter

    if ($key eq 'h')
    {
        ReadMode($RM_RESET);
        print RED(), "Which hostname (blank for all, /.../ for regex): ",
            RESET();
        $config{filter_host} = StringOrRegex(ReadLine(0));
        ReadMode($RM_NOBLKRD);
        next;
    }

    ## E - Show full Replication Error

    if ($key eq 'E')
    {
        my ($data) = Hashes('SHOW /*mytop*/ SLAVE STATUS');
        Clear();
        print "Error is: $data->{Last_Error}\n";
        print RED(), "-- paused. press any key to resume --", RESET();
        ReadKey(0);
        next;
    }
    ## F - remove all filters

    if ($key eq 'F')
    {
        $config{filter_host}  = qr/.?/;
        $config{filter_db}    = qr/.?/;
        $config{filter_user}  = qr/.?/;
        $config{filter_state} = qr/.?/;
        print RED(), "-- display unfiltered --", RESET();
        sleep 1;
        next;
    }

    ## p - pause

    if ($key eq 'p')
    {
        print RED(), "-- paused. press any key to resume --", RESET();
        ReadKey(0);
        next;
    }

    ## i - idle toggle

    if ($key =~ /i/)
    {
        if ($config{idle})
        {
            $config{idle} = 0;
            $config{sort} = 1;
            print RED(), "-- idle (sleeping) processed filtered --", RESET();
            sleep 1;
        }
        else
        {
            $config{idle} = 1;
            $config{sort} = 0;
            print RED(), "-- idle (sleeping) processed unfiltered --", RESET();
            sleep 1;
        }
    }

    ## I - InnoDB status

    if ($key =~ 'I')
    {
        $config{mode} = 'innodb';
        Clear() unless $config{batchmode};
        print "InnoDB Status\n";
        next;
    }

    ## o - sort order

    if ($key =~ /o/)
    {
        if ($config{sort})
        {
            $config{sort} = 0;
            print RED(), "-- sort order reversed --", RESET();
            sleep 1;
        }
        else
        {
            $config{sort} = 1;
            print RED(), "-- sort order reversed --", RESET();
            sleep 1;
        }
    }

    ## ? - help

    if ($key eq '?')
    {
        Clear();
        PrintHelp();
        ReadKey(0);
        next;
    }

    ## k - kill

    if ($key eq 'k')
    {
        ReadMode($RM_RESET);

        print RED(), "Thread id to kill: ", RESET();
        my $id = ReadLine(0);

        $id =~ s/\s//g;

        if ($id =~ /^\d+$/)
        {
            Execute("KILL /*mytop*/ $id");
        }
        else
        {
            print RED(), "-- invalid thread id --", RESET();
            sleep 1;
        }

        ReadMode($RM_NOBLKRD);
        next;
    }

    ## K - kill based on a username
    if ($key =~ /K/)
    {
        ReadMode($RM_RESET);

        print RED(), "User to kill: ", RESET();
        my $user = ReadLine(0);

        $user =~ s/\s//g;

        if ($user =~ /^\S+$/)
        {
            for my $pid (keys %ucache)
            {
                next unless $ucache{$pid} eq $user;
                Execute("KILL /*mytop*/ $pid");
                select(undef, undef, undef, 0.2);
            }
        }
        else
        {
            print RED(), "-- invalid thread id --", RESET();
            sleep 1;
        }

        ReadMode($RM_NOBLKRD);
    }

    ## f - full info

    if ($key =~ /f/)
    {
        ReadMode($RM_RESET);
        print RED(), "Full query for which thread id: ", RESET();
        my $id = ReadLine(0);
        chomp $id;
        FullQueryInfo($id);
        ReadMode($RM_NOBLKRD);
        print RED(), "-- paused. press any key to resume or (e) to explain --",
            RESET();
        my $key = ReadKey(0);

        if ($key eq 'e')
        {
            Explain($id);
            print RED(), "-- paused. press any key to resume --", RESET();
            ReadKey(0);
        }

        next;
    }

    ## e - explain

    if ($key =~ /e/)
    {
        ReadMode($RM_RESET);
        print RED(), "Explain which query (id): ", RESET();
        my $id = ReadLine(0);
        chomp $id;
        Explain($id);
        ReadMode($RM_NOBLKRD);
        print RED(), "-- paused. press any key to resume --", RESET();
        ReadKey(0);
        next;
    }

    ## r - reset status counters

    if ($key =~ /r/)
    {
        Execute("FLUSH /*mytop*/ STATUS");
        print RED(), "-- counters reset --", RESET();
        sleep 1;
        next;
    }

    ## H - header toggle

    if ($key eq 'H')
    {
        if ($config{header})
        {
            $config{header} = 0;
        }
        else
        {
            $config{header}++;
        }
    }

    ## # - magic debug key

    if ($key eq '#')
    {
        $debug = 1;
    }

    if ($key eq 'V')
    {
        GetShowVariables();
        print RED(), "-- paused. press any key to resume --", RESET();
        ReadKey(0);
    }

    ## M - switch to SHOW STATUS mode

    if ($key eq 'M')
    {
        $config{mode} = 'status';
    }

   ## L - full queries toggle

    if ($key eq 'L')
    {
        if ($config{fullqueries})
        {
            $config{fullqueries} = 0;
            print RED(), "-- full queries OFF --", RESET();
            sleep 1;
        }
        else
        {
            $config{fullqueries} = 1;
            print RED(), "-- full queries ON --", RESET();
            sleep 1;
        }
    }

    ## w - change columns width for the "User" and "Database" columns

    if ($key eq 'w')
    {
        ReadMode($RM_RESET);
        print RED(), "Width for the 'User' column (the actual value is ".
                      $config{usercol_width}."): ";
        my $readWidth = ReadLine(0);
        chomp($readWidth);
        if (defined($readWidth) && $readWidth ne "")
        {
            if ($readWidth > 4 && $readWidth < 60)
            {
                $config{usercol_width} = $readWidth;
            }
            else
            {
                print RED(), "-- Invalid value ($readWidth), the previous value".
                             "has been kept, press a key to resume --";
                ReadKey(0);
            }
        }
        print RESET(), RED(), "Width for the 'DB' column (the actual value is ".
                               $config{dbcol_width}."): ", RESET();
        $readWidth = ReadLine(0);
        chomp($readWidth);
        if (defined($readWidth) && $readWidth ne "")
        {
            if ($readWidth > 2 && $readWidth < 60)
            {
                $config{dbcol_width} = $readWidth
            }
            else
            {
                print RED(), "-- Invalid value ($readWidth), the previous value".
                             "has been kept, press a key to resume --", RESET();
                ReadKey(0);
            }
        }
        undef $readWidth;
        ReadMode($RM_NOBLKRD);
        next;
    }

    ## a - progress column toggle (the column is only displayed
    ##     if progress information are available from the processlist)

    if ($key eq 'a')
    {
        if ($config{hide_progress})
        {
            $config{hide_progress} = 0;
            print RED(), "-- progress display ON --", RESET();
            sleep 1;
        }
        else
        {
            $config{hide_progress} = 1;
            print RED(), "-- progress display OFF --", RESET();
            sleep 1;
        }
    }

}

ReadMode($RM_RESET) unless $config{batchmode};

exit;

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

sub Clear()
{
    if (not $WIN)
    {
        print "$CLEAR"
    }
    else
    {
        print "\n" x 90; ## dumb hack for now. Anyone know how to
                         ## clear the screen in dos window on a Win32
                         ## system??
    }
}

my $last_time;

sub GetData()
{
    ## Get terminal info
    my $now_time;
    %qcache = ();  ## recycle memory
    %dbcache = ();

    my ($width, $height, $wpx, $hpx, $lines_left);

    if (not $config{batchmode})
    {
        ($width, $height, $wpx, $hpx) = GetTerminalSize();
        $lines_left = $height - 2;
    }
    else
    {
        $height = 999_999;     ## I hope you don't have more than that!
        $lines_left = 999_999;
        $width = 80;
    }

    ##
    ## Header stuff.
    ##
    if ($config{header})
    {
        my @recs = "";
        if ($db_release > 4)
        {
            @recs = Hashes("SHOW /*mytop*/ GLOBAL STATUS");
        }
        else
        {
           @recs = Hashes("SHOW /*mytop*/ STATUS");
        }

        ## if the server died or we lost connectivity
        if (not @recs)
        {
            ReadMode($RM_RESET);
            exit 1;
        }

        ## get high-res or low-res time
        my ($t_delta);

        if ($HAS_TIME)
        {
            $now_time = Time::HiRes::gettimeofday();
        }
        else
        {
            $now_time = time;
        }

        if ($last_time and $last_time != $now_time)
        {
          $t_delta = $now_time - $last_time;
        }

        %OLD_STATUS = %STATUS;
        # Set some status that may not exist in all versions
        $STATUS{Handler_tmp_write} = 0;
        $STATUS{Handler_tmp_update} = 0;
        $STATUS{Rows_tmp_read} = 0;

        foreach my $ref (@recs)
        {
            my $key = $ref->{Variable_name};
            my $val = $ref->{Value};

            $STATUS{$key} = $val;
        }

        ## Compute Key Cache Hit Stats

        $STATUS{Key_read_requests} ||= 1; ## can't divide by zero next

        my $cache_hits_percent = (100-($STATUS{Key_reads}/$STATUS{Key_read_requests}) * 100);
        $cache_hits_percent = sprintf("%2.2f",$cache_hits_percent);

        ## Query Cache info for <= Ver. 4.1
        ##
        ## mysql> show status like 'qcache%';
        ## +-------------------------+----------+
        ## | Variable_name           | Value    |
        ## +-------------------------+----------+
        ## | Qcache_queries_in_cache | 81       |
        ## | Qcache_inserts          | 4961668  |
        ## | Qcache_hits             | 1374170  |
        ## | Qcache_not_cached       | 5656249  |
        ## | Qcache_free_memory      | 33164800 |
        ## | Qcache_free_blocks      | 2        |
        ## | Qcache_total_blocks     | 168      |
        ## +-------------------------+----------+
        ##
        ## Query Cache info for => Ver. 5.0
        ##
        ## mysql> show status like 'qcache%';
        ## +-------------------------+------------+
        ## | Variable_name           | Value      |
        ## +-------------------------+------------+
        ## | Qcache_free_blocks      | 37652      |
        ## | Qcache_free_memory      | 110289712  |
        ## | Qcache_hits             | 1460617356 |
        ## | Qcache_inserts          | 390563495  |
        ## | Qcache_lowmem_prunes    | 6414172    |
        ## | Qcache_not_cached       | 93002420   |
        ## | Qcache_queries_in_cache | 66558      |
        ## | Qcache_total_blocks     | 192031     |
        ## +-------------------------+------------+

        my $query_cache_hits             = 0;
        my $query_cache_hits_per_sec     = 0;
        my $now_query_cache_hits_per_sec = 0;

        if ($have_query_cache)
        {
            $query_cache_hits = $STATUS{Qcache_hits};
            $query_cache_hits_per_sec = $STATUS{Qcache_hits} / $STATUS{Uptime};

            if (defined $last_time and $last_time != $now_time)
            {
                my $q_delta = $STATUS{Qcache_hits} - $OLD_STATUS{Qcache_hits};
                $now_query_cache_hits_per_sec = sprintf "%.2f", $q_delta / $t_delta;
            }
        }

        my $l;
        if (-e "/proc/loadavg")
        {
            ## To avoid warnings if the OS is not Linux
            open (my $fh, "<", "/proc/loadavg");
            ## Only the first 3 values are interresting
            $l = join(" ", (split /\s+/, <$fh>)[0..2]);
            close $fh;
        }

        $last_time = $now_time;

        ## Server Uptime in meaningful terms...

        my $time         = $STATUS{Uptime};
        my ($d,$h,$m,$s) = (0, 0, 0, 0);

        $d += int($time / (60*60*24)); $time -= $d * (60*60*24);
        $h += int($time / (60*60));    $time -= $h * (60*60);
        $m += int($time / (60));       $time -= $m * (60);
        $s += int($time);

        my $uptime = sprintf("%d+%02d:%02d:%02d", $d, $h, $m, $s);

        ## Queries per second...

        my $avg_queries_per_sec  = sprintf("%.2f", $STATUS{Questions} / $STATUS{Uptime});
        my $num_queries          = $STATUS{Questions};

        my @t = localtime(time);

        my $current_time = sprintf "[%02d:%02d:%02d]", $t[2], $t[1], $t[0];

        my $host_width = length("$server $db_version on $config{host}");
        my $up_width   = $width - $host_width - 1;
        Clear() unless $config{batchmode};
        print RESET();

        printf "%-.${host_width}s %${up_width}s\n",
               "$server $db_version on $config{host}",
               defined($l) ? "load ($l) up $uptime $current_time" : "up $uptime $current_time";
        $lines_left--;


        printf " Queries: %-7s  qps: %4.0f Slow: %7s         Se/In/Up/De(%%):    %02.0f/%02.0f/%02.0f/%02.0f\n",
               make_short( $STATUS{Questions} ),  # q total
               $STATUS{Questions} / $STATUS{Uptime},  # qps, average
               make_short( $STATUS{Slow_queries} ),    # slow

               # hmm. a Qcache hit is really a select and should be counted.
               100 * ($STATUS{Com_select} + ($STATUS{Qcache_hits}||0) )    / $STATUS{Questions},
               100 * ($STATUS{Com_insert} +  $STATUS{Com_replace} ) / $STATUS{Questions},
               100 * ($STATUS{Com_update} )  / $STATUS{Questions},
               100 * $STATUS{Com_delete} / $STATUS{Questions};

        $lines_left--;

        if ($t_delta)
        {
          my $q_diff = ( $STATUS{Questions} - $OLD_STATUS{Questions} );
#         print("q_diff: $STATUS{Questions} - $OLD_STATUS{Questions}  / $t_delta = $q_diff\n");

          printf(" Sorts: %6.0f qps now: %4.0f Slow qps: %3.1f  Threads: %4.0f (%4.0f/%4.0f) %02.0f/%02.0f/%02.0f/%02.0f\n",
                 ( $STATUS{Sort_rows} - $OLD_STATUS{Sort_rows} ) / $t_delta,

                 ( $STATUS{Questions} - $OLD_STATUS{Questions} ) / $t_delta,
                 ( # slow now (qps)
                  ($STATUS{Slow_queries} ) ?
                  ( $STATUS{Slow_queries} - $OLD_STATUS{Slow_queries} ) / $t_delta :
                  0
                 ),
                 $STATUS{Threads_connected},
                 $STATUS{Threads_running},
                 $STATUS{Threads_cached},

                 (100 * ($STATUS{Com_select} - $OLD_STATUS{Com_select} +
                         ($STATUS{Qcache_hits}||0) - ($OLD_STATUS{Qcache_hits}||0)
                        ) ) / ($q_diff ),
                 (100 * ($STATUS{Com_insert} - $OLD_STATUS{Com_insert} +
                         $STATUS{Com_replace} - $OLD_STATUS{Com_replace}
                        ) ) / ($q_diff ),
                 (100 * ($STATUS{Com_update} - $OLD_STATUS{Com_update}) ) / ($q_diff ),
                 (100 * ($STATUS{Com_delete} - $OLD_STATUS{Com_delete}) ) / ($q_diff ),
                 );
        }
        else
        {
            print "\n";
        }
        $lines_left--;

        if ($have_query_cache and $STATUS{Com_select} and $query_cache_hits)
        {
          printf(" Cache Hits: %-5s Hits/s: %4.1f Hits now: %5.1f  Ratio: ",
                 make_short($STATUS{Qcache_hits}),        # cache hits
                 $STATUS{Qcache_hits} / $STATUS{Uptime}, # hits / sec
                 ($t_delta) ?  ($STATUS{Qcache_hits} - $OLD_STATUS{Qcache_hits}) / $t_delta : 0,  # Hits Now
                 );

          my ($Ratio) =  100 * ($STATUS{Qcache_hits})  / ($STATUS{Qcache_hits} + $STATUS{Com_select} );
          if ($HAS_COLOR)
          {
                print YELLOW() if ($Ratio < 80.0);
                print RED() if ($Ratio < 50.0);
                print MAGENTA() if ($Ratio < 20.0);
          }
          printf("%4.1f%% ",$Ratio);
          if ($HAS_COLOR)
          {
                print RESET();
          }

          print " Ratio now: ";
          my ($Ratio_now) = ($t_delta) ?   # ratio now
                 100 * ($STATUS{Qcache_hits} - $OLD_STATUS{Qcache_hits} ) /
                 ( ($STATUS{Com_select} + $STATUS{Qcache_hits} -
                    ($OLD_STATUS{Qcache_hits} + $OLD_STATUS{Com_select})
                   ) || 1) : 0;
          if ($HAS_COLOR)
          {
                print GREEN() if ($Ratio_now >= 80.0);
                print YELLOW() if ($Ratio_now < 80.0);
                print RED() if ($Ratio_now < 50.0);
                print MAGENTA() if ($Ratio_now < 20.0);
          }
          printf("%4.1f%% \n",$Ratio_now);
          if ($HAS_COLOR)
          {
                print RESET();
          }
          $lines_left--;
        }

        if ($t_delta)
        {
          my $rows_read;
          if (defined($STATUS{Rows_read}))
          {
            $rows_read= $STATUS{Rows_read} - $OLD_STATUS{Rows_read};
          }
          else
          {
            $rows_read=
              ($STATUS{Handler_read_first} + $STATUS{Handler_read_key} +
               $STATUS{Handler_read_next} + $STATUS{Handler_read_prev} +
               $STATUS{Handler_read_rnd} + $STATUS{Handler_read_rnd_next} -
               $OLD_STATUS{Handler_read_first} - $OLD_STATUS{Handler_read_key} -
               $OLD_STATUS{Handler_read_next} - $OLD_STATUS{Handler_read_prev} -
               $OLD_STATUS{Handler_read_rnd} - $OLD_STATUS{Handler_read_rnd_next});
          }
          printf(" Handler: (R/W/U/D) %5d/%5d/%5d/%5d        Tmp: R/W/U: %5d/%5d/%5d\n",
                 $rows_read/$t_delta,
                 ($STATUS{Handler_write} - $OLD_STATUS{Handler_write}) /
                 $t_delta,
                 ($STATUS{Handler_update} - $OLD_STATUS{Handler_update}) /
                 $t_delta,
                 ($STATUS{Handler_delete} - $OLD_STATUS{Handler_delete}) /
                 $t_delta,
                 ($STATUS{Rows_tmp_read} - $OLD_STATUS{Rows_tmp_read}) /
                 $t_delta,
                 ($STATUS{Handler_tmp_write}
                 -$OLD_STATUS{Handler_tmp_write})/$t_delta,
                 ($STATUS{Handler_tmp_update} -
                 $OLD_STATUS{Handler_tmp_update})/$t_delta);
        }
        else
        {
            print "\n";
        }

        $lines_left--;

        printf(" MyISAM Key Cache Efficiency: %2.1f%%  Bps in/out: %5s/%5s   ",
               $cache_hits_percent,
               make_short($STATUS{Bytes_received} / $STATUS{Uptime} ),
               make_short($STATUS{Bytes_sent} / $STATUS{Uptime}));
        printf("Now in/out: %5s/%5s",
               make_short(($STATUS{Bytes_received} - $OLD_STATUS{Bytes_received}) / $t_delta ),
               make_short(($STATUS{Bytes_sent} - $OLD_STATUS{Bytes_sent}) / $t_delta ))
          if ($t_delta);
        print "\n";

        $lines_left--;

        my ($data) = Hashes('SHOW /*mytop*/ GLOBAL VARIABLES LIKE "read_only"');
        if ($data->{Value} ne "OFF")
        {
            print RED() if ($HAS_COLOR) ;
            print " ReadOnly";
            RESET() if ($HAS_COLOR);
        }

        ($data) = Hashes('SHOW /*mytop*/ SLAVE STATUS');
        if (defined($data->{Master_Host}))
        {
            if (defined($data->{Seconds_Behind_Master}))
            {
                if ($HAS_COLOR)
                {
                    print GREEN();
                    print YELLOW() if ($data->{Seconds_Behind_Master}  >  60);
                    print MAGENTA() if ($data->{Seconds_Behind_Master} > 360);
                }
            }
            print " Replication ";
            print "IO:$data->{Slave_IO_Running} ";
            print "SQL:$data->{Slave_SQL_Running} ";
            print RESET() if ($HAS_COLOR);

            if (defined($data->{Seconds_Behind_Master}))
            {
                if ($HAS_COLOR)
                {
                    print GREEN();
                    print YELLOW() if ($data->{Seconds_Behind_Master}  >  60);
                    print MAGENTA() if ($data->{Seconds_Behind_Master} > 360);
                }
                print "Delay: $data->{Seconds_Behind_Master} sec.";
            }
            else
            {
                my $free = $width - 45;
                my $Err = substr $data->{Last_Error},0 ,$free;
                printf(" ERR: %-${free}s", $Err) if ($Err ne "");
            }
            print WHITE() if ($HAS_COLOR);
            print "\n";
            $lines_left--;
        }
        print "\n";
    }

    if (not $config{batchmode} and not $config{header})
    {
        Clear();
        print RESET();
    }

    ##
    ## Threads
    ##

    my $proc_cmd;  ## Query used to fetch the processlist
    my $time_format = "6d";

    if ($has_is_processlist == 1)
    {
        if ($has_time_ms == 1)
        {
            $time_format = "6.6s";
            if ($has_progress == 1)
            {
                ## To have a computed value of "Progress" like the
                ## "SHOW PROCESSLIST" one, the Progress column of the query
                ## must be replaced by :
                ## "CASE WHEN Max_Stage < 2 THEN Progress ELSE
                ## (Stage-1)/Max_Stage*100+Progress/Max_Stage END AS Progress"
                $proc_cmd = "SELECT /*mytop*/ Id, User, Host, db, Command,
                             CASE WHEN TIME > 10000 THEN Time ELSE
                             ROUND(TIME_MS/1000, 1) END AS Time,
                             State, Info, Progress, Stage, Max_Stage
                             FROM INFORMATION_SCHEMA.PROCESSLIST
                             WHERE ID != CONNECTION_ID();";
            }
            else
            {
                $proc_cmd = "SELECT /*mytop*/ Id, User, Host, db, Command,
                             CASE WHEN TIME > 10000 THEN Time ELSE
                             ROUND(TIME_MS/1000, 1) END AS Time,
                             State, Info FROM INFORMATION_SCHEMA.PROCESSLIST
                             WHERE ID != CONNECTION_ID();";
           }
        }
        else
        {
            $proc_cmd = "SELECT /*mytop*/ Id, User, Host, db, Command, Time,
                         State, Info FROM INFORMATION_SCHEMA.PROCESSLIST
                         WHERE ID != CONNECTION_ID();";
        }
    }
    else
    {
        $proc_cmd = "SHOW /*mytop*/ FULL PROCESSLIST;";
    }

    ## Minimal width values for columns with a dynamic width
    if ($config{usercol_width} < 4) { $config{usercol_width} = 4; }
    if ($config{dbcol_width} < 2)   { $config{dbcol_width}   = 2; }

    my @sz   = (9, $config{usercol_width}, 15, $config{dbcol_width}, 6, 6, 8);
    if ($has_progress == 1 && !$config{hide_progress}) { push @sz, 5; };
    my $used = scalar(@sz) + Sum(@sz);
    undef(@sz);

    ## If the terminal width <= 80, the state column will have a width of 6
    ## chars else it will be between 6 and 15 depending on the terminal width
    my $state = $width <= 80 ? 6 : int(min(6+($width-80)/3, 15));
    ## $free = The number of chars between the beginning of the "Query"
    ## column and the end of the line
    my $free = $width - $used - ($state - 6);
    my $format= "%9s %$config{usercol_width}s %15s %$config{dbcol_width}s %6s ";
    if ($has_progress == 1 && !$config{hide_progress}) { $format .= "%5s "; }
    $format .= "%6s %${state}s %-.${free}s\n";

    my $format2 = "%9d %$config{usercol_width}.$config{usercol_width}s %15.15s %$config{dbcol_width}.$config{dbcol_width}s %${time_format} ";
    if ($has_progress == 1 && !$config{hide_progress}) { $format2 .= "%5.1f "; }
    $format2 .= "%6.6s %${state}.${state}s ";
    if ($config{fullqueries})
    {
        $format2 .= "%-${free}s\n";
    }
    else
    {
        $format2 .= "%-${free}.${free}s\n";
    }

    print BOLD() if ($HAS_COLOR);

    if ($has_progress == 1 && !$config{hide_progress})
    {
        printf $format,
            'Id','User','Host/IP','DB','Time', '%', 'Cmd', 'State', 'Query';
    }
    else
    {
        printf $format,
            'Id','User','Host/IP','DB','Time', 'Cmd', 'State', 'Query';
    }

    print RESET() if ($HAS_COLOR);

    ## Id User Host DB
    if ($has_progress == 1 && !$config{hide_progress})
    {
        printf $format,
            '--','----','-------','--','----', '-', '---', '-----', '----------';
    }
    else
    {
        printf $format,
            '--','----','-------','--','----', '---', '-----', '----------';
    }

    $lines_left -= 2;

    my @data = Hashes($proc_cmd);

    foreach my $thread (@data)
    {
        last if not $lines_left;

        ## Drop Domain Name, unless it looks like an IP address.  If
        ## it's an IP, we'll strip the port number because it's rarely
        ## interesting.

        my $is_ip = 0;

        if ($thread->{Host} =~ /^(\d{1,3}\.){3}(\d{1,3})(:\d+)?$/)
        {
            $thread->{Host} =~ s/:.*$//;
            $is_ip = 1;
        }
        else
        {
            $thread->{Host} =~ s/^([^.]+).*/$1/;
        }

        ## Otherwise, look up the IP (if resolve is set) and strip the
        ## name
        if ($is_ip and $config{resolve})
        {
            $thread->{Host} =~ s/:\d+$//;
            my $host = gethostbyaddr(inet_aton($thread->{Host}), AF_INET);
            if ($host)
            {
                ## Only the hostname part of the DNS is kept
                $host =~ s/^([^.]+).*/$1/;
            }
            $thread->{Host} = $host;
        }

        ## Fix possible undefs

        $thread->{db}      ||= '';
        $thread->{Info}    ||= '';
        $thread->{Time}    ||= 0 ;
        $thread->{Id}      ||= 0 ;
        $thread->{User}    ||= '';
        $thread->{Command} ||= '';
        $thread->{Host}    ||= '';
        $thread->{State}   ||= "";
        $thread->{Progress} ||= 0;

        ## Alter double hyphen comments so they don't break
        ## the query when newlines are removed - http://freshmeat.net/users/jerjones
        $thread->{Info} =~ s~\s--(.*)$~ /* $1 */ ~mg;

        ## Normalize spaces -- mostly disabled for now.  This can
        ## break EXPLAIN if you try to explain a mangled query.  It
        ## may be re-enabled later as an option.

        ## Replace newlines and carriage returns with a space
        $thread->{Info} =~ tr/\n\r/ /;

        ## Leading space removal
        $thread->{Info} =~ s/^\s*//;

        ## Strip non printing control symbols
        $thread->{Info} =~ tr/[[:cntrl:]]//;

        ## Collpase whitespace
        $thread->{Info} =~ s/\s+/ /g;

        ## Trailing space removal
        $thread->{Info} =~ s/\s$//;

        ## Put the first letter of the query uppercase for a better readability
        ## with long State strings
        $thread->{Info} = ucfirst $thread->{Info};

        ## Stow it in the cache
        $qcache{$thread->{Id}}  = $thread->{Info};
        $dbcache{$thread->{Id}} = $thread->{db};
        $ucache{$thread->{Id}}  = $thread->{User};

        ## If Progress information is available and a multi-stage query is
        ## running, the actual stage and the total number of stages of the
        ## thread are shown at the beginning of the State column
        if ($has_progress == 1 && $thread->{Max_Stage} && $thread->{Max_Stage} > 1)
        {
            $thread->{State} = $thread->{Stage}."/".
                               $thread->{Max_Stage}." ".$thread->{State};
        }
    }

    ## Sort by idle time (closest thing to CPU usage I can think of).

    my @sorted;

    if (not $config{sort})
    {
        @sorted = sort { $a->{Time} <=> $b->{Time} } @data
    }
    else
    {
        @sorted = sort { $b->{Time} <=> $a->{Time} } @data
    }

    foreach my $thread (@sorted)
    {
        ## Check to see if we can skip out.
        ## We skip out if we know the given line doesn't match.

        next if (($thread->{Command} eq "Sleep")
                 and
                 (not $config{idle}));

        next if (($thread->{Command} eq "Binlog Dump")
                 and
                 (not $config{idle}));

        next if (($thread->{Command} eq "Daemon")
                 and
                 (not $config{idle}));

        next if ($thread->{User}  !~ $config{filter_user});
        next if ($thread->{db}    !~ $config{filter_db});
        next if ($thread->{Host}  !~ $config{filter_host});
        next if ($thread->{State} !~ $config{filter_state});

        ## Otherwise, print.

        my $smInfo;

        if ($thread->{Info})
        {
            if ($config{fullqueries})
            {
                $smInfo = $thread->{Info};
                if (length($smInfo) > $free)
                {
                    $lines_left -= int((length($smInfo) - $free)/$width) + 1;
                }
            }
            else
            {
                $smInfo = substr $thread->{Info}, 0, $free;
            }
        }
#        if ($thread->{State})
#        {
#            $smInfo = substr $thread->{State}, 0, $free;
#        }
        else
        {
            $smInfo = "";
        }

        $lines_left--;
        if ($lines_left < 0)
        {
            print WHITE(), "-- Truncated query list --  ";
            last;
        }

        if ($HAS_COLOR)
        {
            print YELLOW() if $thread->{Command} eq 'Query';
            print WHITE()  if $thread->{Command} eq 'Sleep';
            print GREEN()  if $thread->{Command} eq 'Connect';
            print BOLD()   if $thread->{Time} > $config{slow};
            print MAGENTA() if $thread->{Time} > $config{long};
        }

        if ($has_progress == 1 && !$config{hide_progress})
        {
            printf $format2,
                $thread->{Id}, $thread->{User}, $thread->{Host}, $thread->{db},
                $thread->{Time}, $thread->{Progress}, $thread->{Command},
                $thread->{State}, $smInfo;
        }
        else
        {
            printf $format2,
                $thread->{Id}, $thread->{User}, $thread->{Host}, $thread->{db},
                $thread->{Time}, $thread->{Command}, $thread->{State}, $smInfo;
        }

        print RESET() if $HAS_COLOR;
    }

}

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

my $questions;

sub GetQPS()
{
    my ($data) = Hashes('SHOW /*mytop*/ STATUS LIKE "Questions"');
    my $num   = $data->{Value};

    if (not defined $questions) ## first time?
    {
        $questions = $num;
        return;
    }

    my $qps = $num - $questions;
    $questions = $num;
    print "$qps\n";
}

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

sub GetInnoDBStatus()
{
    if (not $config{pager})
    {
        if (not $config{pager} = my_which('less'))
        {
            $config{pager} = my_which('more');
        }
    }

    my @data = Hashes("SHOW /*mytop*/ ENGINE INNODB STATUS");

    open P, "|$config{pager}" or die "$!";
    print keys %{$data[0]};
    print $data[0]->{Status},"\n";
    close P;
}

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

my %prev_data;

sub GetCmdSummary()
{
    my ($width, $height, $wpx, $hpx, $lines_left);

    if (not $config{batchmode})
    {
        ($width, $height, $wpx, $hpx) = GetTerminalSize();

        $lines_left = $height - 2;
    }
    else
    {
        $height = 999_999;     ## I hope you don't have more than that!
        $lines_left = 999_999;
        $width = 80;
    }

    ## Variable_name and Value pairs come back...
    my @data = Hashes("SHOW /*mytop*/ STATUS LIKE 'Com\\_%'");
    my %cmd_data;
    my %cmd_delta;
    my %cmd_pct;
    my %cmd_delta_pct;
    my $total;
    my $delta_total;

    for my $item (@data)
    {
        next unless $item->{Value};
        $item->{Variable_name} =~ s/^Com_//;
        $item->{Variable_name} =~ s/_/ /g;
        $cmd_data{$item->{Variable_name}} = $item->{Value};
        $total += $item->{Value};
    }

    ## Populate other stats

    for my $item (keys %cmd_data)
    {
        $cmd_delta{$item} = $cmd_data{$item} -
            ($prev_data{$item} || $cmd_data{$item} - 1);

        $delta_total += $cmd_delta{$item};

        $cmd_pct{$item}  = int(($cmd_data{$item} / $total) * 100);
    }

    for my $item (keys %cmd_data)
    {
        $cmd_delta_pct{$item}  = int(($cmd_delta{$item} / $delta_total) * 100);
    }


    ## Display

    Clear() unless $config{batchmode};
    print RESET();
    printf "%18s %10s %4s  | %5s %4s\n", 'Command', 'Total', 'Pct', 'Last', 'Pct';
    printf "%18s %10s %4s  | %5s %4s\n", '-------', '-----', '---', '----', '---';
    $lines_left -= 2;

    for my $item (sort { $cmd_data{$b} <=> $cmd_data{$a} } keys %cmd_data)
    {
        printf "%18s %10d %4s  | %5d %4s\n",
            $item,
            $cmd_data{$item},
            $cmd_pct{$item} . "%",
            $cmd_delta{$item},
            $cmd_delta_pct{$item} . "%";

        last if not $lines_left;
        $lines_left -= 1;
    }

    %prev_data = %cmd_data;
}

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

sub GetShowVariables()
{
    if (not $config{pager})
    {
        if (not $config{pager} = my_which('less'))
        {
            $config{pager} = my_which('more');
        }
    }

    my @rows = Hashes("SHOW /*mytop*/ VARIABLES");

    open P, "|$config{pager}" or die "$!";

    for my $row (@rows)
    {
        my $name  = $row->{Variable_name};
        my $value = $row->{Value};
        printf P "%32s: %s\n", $name, $value;
    }

    close P;
}

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

sub GetShowStatus()
{
    Clear() unless $config{batchmode};
    my @rows = Hashes("SHOW /*mytop*/ STATUS");

    printf "%32s  %10s %10s   Toggle idle with 'i'\n", 'Counter', 'Total', 'Change';
    printf "%32s  %10s %10s\n", '-------', '-----', '------';

    for my $row (@rows)
    {
        my $name  = $row->{Variable_name};
        my $value = $row->{Value};
        my $old   = $statcache{$name};
        my $delta = 0;

        next if $name  =~ m/^Com_/;      ## skip Com_ stats
        next if $value =~ m/^[^0-9]*$/;  ## skip non-numeric

        ## TODO: if Qcache is off, we should skip Qcache_ values

        if ($HAS_COLOR and defined $old and $old =~ /^\d/)
        {
            if ($value > $old)
            {
                print YELLOW();
                $delta = $value - $old;
            }
            elsif ($value < $old)
            {
                print RED();
                $delta = $value - $old;
            }

            if (not $config{idle} and $value == $old)
            {
                ## filter unchanging stats, maybe
                print RESET();
                next;
            }
        }

        printf "%32s: %10s %10s\n", $name, $value, $delta;
        print RESET() if $HAS_COLOR;

        $statcache{$name} = $value;
    }

}

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

sub FullQueryInfo($)
{
    my $id = shift;

    if (not exists $qcache{$id} or not defined $qcache{$id})
    {
        print "*** Invalid id. ***\n";
        return;
    }

    my $sql = $qcache{$id};
    print $CLEAR;
    print "Thread $id was executing following query:\n\n";
    print YELLOW(), $sql,"\n\n", RESET();
}

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

sub Explain($)
{
    my $id  = shift;

    if (not exists $qcache{$id} or not defined $qcache{$id})
    {
        print "*** Invalid id. ***\n";
        return;
    }

    my $sql = $qcache{$id};
    my $db  = $dbcache{$id};

    Execute("USE /*mytop*/ $db");
    my @info = Hashes("EXPLAIN $sql");
    print $CLEAR;
    print "EXPLAIN $sql:\n\n";
    PrintTable(@info);
}

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

sub PrintTable(@)
{
    my $cnt = 1;
    my @cols = qw(table type possible_keys key key_len ref rows Extra);

    for my $row (@_)
    {
        print "*** row $cnt ***\n";
        for my $key (@cols)
        {
            my $val = $row->{$key} || 'NULL';
            printf "%15s:  %s\n", $key, $val;
        }
        $cnt++;
    }
}

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

sub StringOrRegex($)
{
    my $input = shift;
    chomp $input;
    if (defined $input)
    {
        ## regex, strip /.../ and use via qr//
        if ($input =~ m{^/} and $input =~ m{/$})
        {
            $input =~ s{^/}{} if $config{filter_user};
            $input =~ s{/$}{} if $config{filter_user};
            $input =  qr/$input/;
        }


        ## reset to match anything
        elsif ($input eq '')
        {
            $input = qr/.*/;
        }

        ## string, build a simple regex
        else
        {
            $input =  '^' . $input . '$';
            $input = qr/$input/;
        }
    }

    ## reset to match anything
    else
    {
        $input = qr/.*/;
    }
    return $input;
}

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

sub cmd_l
{
    ReadMode($RM_RESET);

    print RED(), "Seconds for long queries: ", RESET();
    my $secs = ReadLine(0);

    if ($secs =~ /^\s*(\d+)/)
    {
        $config{long} = $1;
        if ($config{long} < 1)
        {
            $config{long} = 1;
        }
    }
    ReadMode($RM_NOBLKRD);
}

sub cmd_s
{
    ReadMode($RM_RESET);

    print RED(), "Seconds of Delay: ", RESET();
    my $secs = ReadLine(0);

    if ($secs =~ /^\s*(\d+)/)
    {
        $config{delay} = $1;
        if ($config{delay} < 1)
        {
            $config{delay} = 1;
        }
    }
    ReadMode($RM_NOBLKRD);
}

sub cmd_S
{
    ReadMode($RM_RESET);

    print RED(), "Seconds for Slow queries: ", RESET();
    my $secs = ReadLine(0);

    if ($secs =~ /^\s*(\d+)/)
    {
        $config{slow} = $1;
        if ($config{slow} < 1)
        {
            $config{slow} = 1;
        }
    }
    ReadMode($RM_NOBLKRD);
}

sub cmd_q
{
    ReadMode($RM_RESET);
    print "\n";
    exit;
}

sub trim($)
{
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}

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

sub PrintHelp()
{
    my $help = qq[Help for mytop version $main::VERSION by Jeremy D. Zawodny <${YELLOW}Jeremy\@Zawodny.com${RESET}>
 with updates by Mark Grennan <${YELLOW}mark\@grennan.com${RESET}> and Jean Weisbuch <${YELLOW}jean\@phpnet.org${RESET}>

  ? - display this screen
  # - debug mode (toggle)
  c - command summary view (based on Com_* counters)
  C - turn color on and off
  d - show only a specific database
  e - explain the query that a thread is running
  E - display current replication error
  f - show full query info for a given thread
  F - unfilter the display
  h - show only a specifc host's connections
  H - toggle the mytop header
  i - toggle the display of idle (sleeping) threads
  I - show innodb status
  k - kill a thread
  p - pause the display
  l - change long running queries hightlighing
  m - switch [mode] to qps (queries/sec) scrolling view
  M - switch [mode] to status
  o - reverse the sort order (toggle)
  q - quit
  r - reset the status counters (via FLUSH STATUS on your server)
  R - change reverse IP lookup
  s - change the delay between screen updates
  S - change slow query hightlighting
  t - switch to thread view (default)
  u - show only a specific user
  V - show variables
  : - enter a command (not yet implemented)
  ! - Skip an error that has stopped replications (at your own risk)
  L - show full queries (do not strip to terminal width)
  w - adjust the User and DB columns width
  a - toggle the progress column

Base version from ${GREEN}http://www.mysqlfanboy.com/mytop-3${RESET}
This version comes as part of the ${GREEN}MariaDB${RESET} distribution.
];

    print $help;
}

sub Sum(@)
{
    my $sum;
    while (my $val = shift @_) { $sum += $val; }
    return $sum;
}

## A useful routine from perlfaq

sub commify($)
{
    local $_  = shift;
    return 0 unless defined $_;
    1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
    return $_;
}

## Compact numeric representation (10,000 -> 10.0k)

sub make_short($)
{
    my $number = shift;
    return commify($number) if $config{long_nums};
    my $n = 0;
    while ($number > 1_025) { $number /= 1024; $n++; };
    return sprintf "%.1f%s", $number, ('','k','M','G', 'T')[$n];
}


## Run a query and return the records has an array of hashes.

sub Hashes($)
{
    my $sql = shift;
    my @records;

    if (my $sth = Execute($sql))
    {
        while (my $ref = $sth->fetchrow_hashref)
        {
            print "record\n" if $debug;
            push @records, $ref;
        }
    }
    return @records;
}

## Execute an SQL query and return the statement handle.

sub Execute($)
{
    my $sql = shift;

    $sql =~ s/\n/ /sg;

    my $sth = $dbh->prepare($sql);

    if (not $sth) { ReadMode($RM_RESET); die $DBI::errstr; }

    my $ReturnCode = $sth->execute;

    if (not $ReturnCode)
    {
        if ($debug)
        {
            print "query failed\n";
            sleep 10;
        }
        return undef;
    }

    return $sth;
}

####
#### my_which is used, because we can't assume that every system has the
#### which command. my_which can take only one argument at a time.
#### Return values: requested system command with the first found path,
#### or undefined, if not found.
####

sub my_which
{
  my ($command) = @_;
  my (@paths, $path);

  return $command if (-f $command && -x $command);

  ## Check first if this is a source distribution, then if this binary distribution and last in the path

  push @paths, "./extra";
  push @paths, $path_for_script;
  push @paths, split(':', $ENV{'PATH'});

  foreach $path (@paths)
  {
    $path .= "/$command";
    return $path if (-f $path && -x $path);
  }
  return undef();
}

=pod

=head1 SYNOPSIS

B<mytop> [options]

=head1 AVAILABILITY

Base version from B<http://www.mysqlfanboy.com/mytop-3>.

This version comes as part of the B<MariaDB> distribution. See B<https://mariadb.org/>.

And older (the original) version B<mytop> is available from
http://www.mysqlfanboy.com/mytop-3/ it B<might> also be on CPAN as
well.

=head1 REQUIREMENTS

In order for B<mytop> to function properly, you must have the
following:

  * Perl 5.005 or newer
  * Getopt::Long
  * DBI and DBD::MariaDB or DBD::mysql
  * Term::ReadKey from CPAN

Most systems are likely to have all of those installed--except for
Term::ReadKey. You will need to pick that up from the CPAN. You can
pick up Term::ReadKey here:

    http://search.cpan.org/search?dist=TermReadKey

And you obviously need access to a MariaDB server with the necessary
security to run the I<SHOW PROCESSLIST> and I<SHOW STATUS> commands.

If you are a Windows user, using ActiveState's Perl, you can use PPM
(the Perl Package Manager) to install the MariaDB/MySQL and Term::ReadKey
modules.

=head2 Optional Color Support

In additon, if you want a color B<mytop> (recommended), install
Term::ANSIColor from the CPAN:

    http://search.cpan.org/search?dist=ANSIColor

Once you do, B<mytop> will automatically use it. However, color is not
yet working on Windows. Patches welcome. :-)

=head2 Optional Hi-Res Timing

If you want B<mytop> to provide more accurate real-time
queries-per-second statistics, install the Time::HiRes module from
CPAN.  B<mytop> will automatically notice that you have it and use it
rather than the standard timing mechanism.

=head2 Platforms

B<mytop> is known to work on:

  * Linux (2.2.x, 2.4.x)
  * FreeBSD (2.2, 3.x, 4.x)
  * Mac OS X
  * BSDI 4.x
  * Solaris 2.x
  * Windows NT 4.x (ActivePerl)

If you find that it works on another platform, please let me
know. Given that it is all Perl code, I expect it to be rather
portable to Unix and Unix-like systems. Heck, it I<might> even work on
Win32 systems.

=head1 DESCRIPTION

Help is always welcome in improving this software. Feel free to
contact the author (see L<"AUTHOR"> below) with bug reports, fixes,
suggestions, and comments. Additionally L<"BUGS"> will provide a list
of things this software is not able to do yet.

Having said that, here are the details on how it works and what you can
do with it.

=head2 The Basics

B<mytop> was inspired by the system monitoring tool B<top>. I
routinely use B<top> on Linux, FreeBSD, and Solaris. You are likely to
notice features from each of them here.

B<mytop> will connect to a MariaDB server and periodically run the
I<SHOW PROCESSLIST> and I<SHOW STATUS> commands and attempt to
summarize the information from them in a useful format.

=head2 The Display

The B<mytop> display screen is really broken into two parts. The top 4
lines (header) contain summary information about your MariaDB
server. For example, you might see something like:

MariaDB 10.5.0 on localhost     load (3.89 3.86 3.91) up 7+23:56:31 [16:33:01]
 Queries: 353.4M   qps:  531 Slow:    4.5k         Se/In/Up/De(%):    87/02/02/00
 Sorts:   2390 qps now:  651 Slow qps: 0.0  Threads:   11 (   1/  13) 88/01/03/00
 Handler: (R/W/U/D) 82138/ 5884/   20/    1        Tmp: R/W/U: 13623/29501/   79
 MyISAM Key Cache Efficiency: 99.9%  Bps in/out: 157.4k/ 2.2M   Now in/out: 554.8k/ 2.6M

The first line identifies the hostname of the server (localhost) and
the version of MariaDB it is running. The right hand side shows the
uptime of the MariaDB server process in days+hours:minutes:seconds
format (much like FreeBSD's top) as well as the current time.

The second line displays the total number of queries the server has
processed, the average number of queries per second, the number of
slow queries, and the percentage of Select, Insert, Update, and Delete
queries.

The third real-time values. First is the number of queries per second,
then the number of slow queries, followed by query precentages (like
on the previous line).

And the fourth line displays key buffer efficiency (how often keys are
read from the buffer rather than disk) and the number of bytes that
MariaDB has sent and received, both over all and in the last cycle.

You can toggle the header by hitting B<H> when running B<mytop>.

The second part of the display lists as many threads as can fit on
screen. By default they are sorted according to their idle time (least
idle first). The display looks like:

    Id     User       Host      Dbase   Time      Cmd Query or State
    --     ----       ----      -----   ----      --- --------------
    61  jzawodn  localhost      music      0    Query show processlist

As you can see, the thread id, username, host from which the user is
connecting, database to which the user is connected, number of seconds
of idle time, the command the thread is executing, and the query info
are all displayed.

Often times the query info is what you are really interested in, so it
is good to run B<mytop> in an xterm that is wider than the normal 80
columns if possible.

The thread display color-codes the threads if you have installed color
support. The current color scheme only works well in a window with a
dark (like black) background. The colors are selected according to the
C<Command> column of the display:

    Query   -  Yellow
    Sleep   -  White
    Connect -  Green
    Slow    -  Bright
    Long    -  Magenta

Those are purely arbitrary and will be customizable in a future
release. If they annoy you just start B<mytop> with the B<--nocolor>
flag or adjust your config file appropriately.

=head2 Arguments

B<mytop> handles long and short command-line arguments. Not all
options have both long and short formats, however. The long arguments
have two dashes `--'. Short arguments only have one '-'.

=over

=item B<-u> or B<--user> username

Username to use when logging in to the MariaDB server. Default: ``B<root>''.

=item B<-p> or B<--pass> or B<--password> I<password>

Password to use when logging in to the MariaDB server. Default: none.

WARNING: This is insecure as the password is visible for anyone.
See B<--prompt> instead!

=item B<-h> or B<--host> I<hostname>[B<:>I<port>]

Hostname of the MariaDB server. The hostname may be followed by an
option port number. Note that the port is specified separate from the
host when using a config file. Default: ``B<localhost>''.

=item B<--port> or B<-P> I<port>

If you're running MariaDB on a non-standard port, use this to specify
the port number. Default: B<3306>.

=item B<-s> or B<--delay> I<seconds>

How long between display refreshes. Default: B<5>

=item B<-d> or B<--db> or B<--database> I<database>

Use if you'd like B<mytop> to connect to a specific database by
default. Default: none.

=item B<-b> or B<--batch> or B<--batchmode>

In batch mode, mytop runs only once, does not clear the screen, and
places no limit on the number of lines it will print. This is suitable
for running periodically (perhaps from B<cron>) to capture the
information into a file for later viewing. You might use batch mode in
a CGI script to occasionally display your MariaDB server status on the
web.

Default: unset.

=item B<-S> or B<--socket> I</path/to/socket>

If you're running B<mytop> on the same host as MariaDB/MySQL, you may wish to
have it use the MariaDB/MySQL socket directly rather than a standard TCP/IP
connection. If you do,just specify one.

Note that specifying a socket will make B<mytop> ignore any host
and/or port that you might have specified. If the socket does not
exist (or the file specified is not a socket), this option will be
ignored and B<mytop> will use the hostname and port number instead.

Default: none.

=item B<--header> or B<--noheader>

Specify if you want the header to display or not. You can toggle this
with the B<h> key while B<mytop> is running.

Default: header.

=item B<--color> or B<--nocolor>

Specify if you want a color display. This has no effect if you don't
have color support available.

Default: If you have color support, B<mytop> will try color unless you
tell it not to.

=item B<-i> or B<--idle> or B<--noi> or B<--noidle>

Specify if you want idle (sleeping) threads to appear in the list. If
sleeping threads are omitted, the default sorting order is reversed so
that the longest running queries appear at the top of the list.

Default: idle.

=item B<--prompt> or B<--noprompt>

Specify if you want to be prompted to type in your database password.
This provides a little bit more security since it not only prevents
the password from viewable in a process list, but also doesn't require
the password to be stored in plain text in your C<~/.mytop> config file.
You will B<only> be prompted if a password has not been specified in
your config file or through another command line option.

Default: noprompt.

=item B<--resolve>

If you have skip-resolve set on MariaDB (to keep it from doing a reverse
DNS lookup on each inbound connection), mytop can replace IP addresses
with hostnames but toggling this option.

Default: noresolve

=item B<--long> or B<--nolong>

For large numbers print all digits (e.g. 10.000) instead of using a more
compact approximation (e.g. 10.0k).

Default: nolong.

=item B<-m> or B<--mode> I<mode>

Specify initial mode B<qps>(queries/second), B<top>(overview),
B<cmd>(command summary), B<innodb>(InnoDB status) or B<status>().

Default: B<top>

=item B<--sort> or B<--nosort>

Reverse sort order from ascending to descending using Idle time.

Default: nosort.


=back

Command-line arguments will always take precedence over config file
options. That happens because the config file is read I<BEFORE> the
command-line arguments are applied.

=head2 Config File

Instead of always using bulky command-line parameters, you can also
use a config files for the default value of your options.

mytop will first read the [client] and [mytop] sections from your
my.cnf files. After that it will read the (C<~/.mytop>) file from your
home directory (if present). These are read I<before> any of your
command-line arguments are processed, so your command-line arguments
will override directives in the config file.


Here is a sample config file C<~/.mytop> which implements the defaults
described above.

  user=root
  pass=
  host=localhost
  db=test
  delay=5
  port=3306
  slow=10
  socket=
  batchmode=0
  header=1
  color=1
  idle=1
  long=120

Using a config file will help to ensure that your database password
isn't visible to users on the command-line. Just make sure that the
permissions on C<~/.mytop> are such that others cannot read it (unless
you want them to, of course).

You may have white space on either side of the C<=> in lines of the
config file.

=head2 Shortcut Keys

The following keys perform various actions while B<mytop> is
running. Those which have not been implemented are listed as
such. They are included to give the user idea of what is coming.

=over

=item B<?>

Display help.

=item B<c>

Show "command counters" based on the Com_* values in SHOW STATUS.
This is a new feature.  Feedback welcome.

=item B<C>

Turn display color on and off. Default is on.

=item B<d>

Show only threads connected to a particular database.

=item B<f>

Given a thread id, display the entire query that thread was (and still
may be) running.

=item B<F>

Disable all filtering (host, user, and db).

=item B<h>

Only show queries from a particular host.

=item B<H>

Toggle the header display. You can also specify either C<header=0> or
C<header=1> in your config file to set the default behavior.

=item B<i>

Toggle the display of idle (sleeping) threads. If sleeping threads are
filtered, the default sorting order is reversed so that the longest
running queries appear at the top of the list.

=item B<I>

Switch to InnoDB Status mode.  The output of "SHOW ENGINE INNODB STATUS" will
be displayed every cycle.  In a future version, this may actually
summarize that data rather than producing raw output.

=item B<k>

Kill a thread.

=item B<m>

Toggle modes. Currently this switches from `top' mode to `qps'
(Queries Per Second Mode). In this mode, mytop will write out one
integer per second. The number written reflects the number of queries
executed by the server in the previous one second interval.

More modes may be added in the future.

=item B<o>

Reverse the default sort order.

=item B<p>

Pause display.

=item B<q>

Quit B<mytop>

=item B<r>

Reset the server's status counters via a I<FLUSH STATUS> command.

=item B<R>

Togle IP reverse lookup. Default is on.

=item B<s>

Change the sleep time (number of seconds between display refreshes).

=item B<S>

Set the number of seconds a query will need to run before it is
considered old and will be highlighted.

=item B<u>

Show only threads owned by a giver user.

=back

The B<s> key has a command-line counterpart: B<-s>.

The B<h> key has two command-line counterparts: B<--header> and
B<--noheader>.

=head1 BUGS

This is more of a BUGS + WishList.

Some performance information is not available when talking to a
version 3.22.x MySQL server. Additional information (about threads
mostly) was added to the output of I<SHOW STATUS> in MySQL 3.23.x and
B<mytop> makes use of it. If the information is not available, you
will simply see zeros where the real numbers should be.

Simply running this program will increase your overall counters (such
as the number of queries run). But you may or may not view that as a
bug.

B<mytop> consumes too much CPU time when running (verified on older
versions of Linux and FreeBSD). It's likely a problem related to
Term::ReadKey. I haven't had time to investigate yet, so B<mytop> now
automatically lowers its priority when you run it. You may also think
about running B<mytop> on another workstation instead of your database
server. However, C<mytop> on Solaris does B<not> have this problem.
Newer versions of Linux and FreeBSD seem to have fixed this.

You can't specify the maximum number of threads to list. If you have
many threads and a tall xterm, B<mytop> will always try to display as
many as it can fit.

The size of most of the columns in the display has a small maximum
width. If you have fairly long database/user/host names the display
may appear odd. I have no good idea as to how best to deal with that
yet. Suggestions are welcome.

It'd be nice if you could just add B<mytop> configuration directives
in your C<my.cnf> file instead of having a separate config file.

You should be able to specify the columns you'd like to see in the
display and the order in which they appear. If you only have one
username that connects to your database, it's probably not worth
having the User column appear, for example.

=head1 AUTHOR

mytop was developed and is maintained by Jeremy D. Zawodny
(Jeremy@Zawodny.com).

If you wish to e-mail me regarding this software, B<PLEASE> subscribe
to the B<mytop> mailing list.  See the B<mytop> homepage for details.

=head1 DISCLAIMER

While I use this software in my job at Yahoo!, I am solely responsible
for it. Yahoo! does not necessarily support this software in any
way. It is merely a personal idea which happened to be very useful in
my job.

=head1 SEE ALSO

Please check the MariaDB manual if you're not sure where some of the
output of B<mytop> is coming from.

=head1 COPYRIGHT

Copyright (C) 2000-2010, Jeremy D. Zawodny.

=head1 CREDITS

Fix a bug. Add a feature. See your name here!

Many thanks go to these fine folks:

=over

=item Jean Weisbuch (jean@phpnet.org)

Added --fullqueries and --sort options, dynamic user and database columns
width, reading of .my.cnf, state/progress column that can be disabled
dynamically (when available) and various small fixes.

=item Michael "Monty" Widenius <monty@askmonty.org>

Fixed a couple of minor bugs that gave warnings on startup.
Added support for MariaDB (show MariaDB at top and % done).
Cut long server version names to display width.
Made 'State' length dynamic.

=item Mark Grennan (mark@grennan.com) www.linuxfangoy.com

Added updates for MySQL 5.x. Added 'S' (slow) highlighting.
Added 'C' to turn on and off Color. Added 'l' command to change
color for long running queries. Fixed a few documentation issues.
Monitors Slave status. Added color to Queue hit ratio.
Added number of rows sorted per second.
Created release 1.7.

=item Sami Ahlroos (sami@avis-net.de)

Suggested the idle/noidle stuff.

=item Jan Willamowius (jan@janhh.shnet.org)

Minor bug report. Documentation fixes.

=item Alex Osipov (alex@acky.net)

Long command-line options, Unix socket support.

=item Stephane Enten (tuf@grolier.fr)

Suggested batch mode.

=item Richard Ellerbrock (richarde@eskom.co.za)

Bug reports and usability suggestions.

=item William R. Mattil (wrm@newton.irngtx.tel.gte.com)

Bug report about empty passwords not working.

=item Benjamin Pflugmann (philemon@spin.de)

Suggested -P command-line flag as well as other changes.

=item Justin Mecham <justin@aspect.net>

Suggested setting $0 to `mytop'.

=item Thorsten Kunz <thorsten.kunz@de.tiscali.com>

Provided a fix for cases when we try remove the domain name from the
display even if it is actually an IP address.

=item Sasha Pachev <sasha@mysql.com>

Provided the idea of real-time queries per second in the main display.

=item Paul DuBois <paul@snake.net>

Pointed out some option-handling bugs.

=item Mike Wexler <mwexler@tias.com>

Suggested that we don't mangle (normalize) whitespace in query info by
default.

=item Mark Zweifel <markez@yahoo-inc.com>

Make the --idle command-line argument negatable.

=item Axel Schwenke <schwenke@jobpilot.de>

Noticed the incorrect formula for query cache hit percentages in
version 1.2.

=item Steven Roussey <sroussey@network54.com>

Supplied a patch to help filter binary junk in queries so that
terminals don't freak out.

=item Jon R. Luini <falcon@chime.com>

Supplied a patch that formed the basis for C<--prompt> support.
Sean Leach <sleach@wiggum.com> submitted a similar patch.

=item Yogish Baliga <baliga@yahoo-inc.com>

Supplied a patch that formed the basis for C<--resolve> support.

=item Per Andreas Buer <perbu@linpro.no>

Supplied an excellent patch to tidy up the top display.  This includes
showing most values in short form, such as 10k rather than 10000.

=back

See the Changes file on the B<mytop> distribution page for more
details on what has changed.

=head1 LICENSE

B<mytop> is licensed under the GNU General Public License version
2. For the full license information, please visit
http://www.gnu.org/copyleft/gpl.html

=cut

__END__