This file is indexed.

/usr/share/perl5/Image/ExifTool/Writer.pl is in libimage-exiftool-perl 10.10-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

   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
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967
5968
5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
6009
6010
6011
6012
6013
6014
6015
6016
6017
6018
6019
6020
6021
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
6061
6062
6063
6064
6065
6066
6067
6068
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
6119
6120
6121
6122
6123
6124
6125
6126
6127
6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
6138
6139
6140
6141
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174
6175
6176
6177
6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
6191
6192
6193
6194
6195
6196
#------------------------------------------------------------------------------
# File:         Writer.pl
#
# Description:  ExifTool write routines
#
# Notes:        Also contains some less used ExifTool functions
#
# URL:          http://owl.phy.queensu.ca/~phil/exiftool/
#
# Revisions:    12/16/2004 - P. Harvey Created
#------------------------------------------------------------------------------

package Image::ExifTool;

use strict;

use Image::ExifTool::TagLookup qw(FindTagInfo TagExists);
use Image::ExifTool::Fixup;

sub AssembleRational($$@);
sub LastInList($);
sub CreateDirectory($$);
sub NextFreeTagKey($$);
sub RemoveNewValueHash($$$);
sub RemoveNewValuesForGroup($$);
sub GetWriteGroup1($$);
sub Sanitize($$);
sub ConvInv($$$$$;$$);

my $loadedAllTables;    # flag indicating we loaded all tables

# the following is a road map of where we write each directory
# in the different types of files.
my %tiffMap = (
    IFD0         => 'TIFF',
    IFD1         => 'IFD0',
    XMP          => 'IFD0',
    ICC_Profile  => 'IFD0',
    ExifIFD      => 'IFD0',
    GPS          => 'IFD0',
    SubIFD       => 'IFD0',
    GlobParamIFD => 'IFD0',
    PrintIM      => 'IFD0',
    IPTC         => 'IFD0',
    Photoshop    => 'IFD0',
    InteropIFD   => 'ExifIFD',
    MakerNotes   => 'ExifIFD',
    CanonVRD     => 'MakerNotes', # (so VRDOffset will get updated)
    NikonCapture => 'MakerNotes', # (to allow delete by group)
);
my %exifMap = (
    IFD1         => 'IFD0',
    EXIF         => 'IFD0', # to write EXIF as a block
    ExifIFD      => 'IFD0',
    GPS          => 'IFD0',
    SubIFD       => 'IFD0',
    GlobParamIFD => 'IFD0',
    PrintIM      => 'IFD0',
    InteropIFD   => 'ExifIFD',
    MakerNotes   => 'ExifIFD',
    NikonCapture => 'MakerNotes', # (to allow delete by group)
    # (no CanonVRD trailer allowed)
);
my %jpegMap = (
    %exifMap, # covers all JPEG EXIF mappings
    JFIF         => 'APP0',
    CIFF         => 'APP0',
    IFD0         => 'APP1',
    XMP          => 'APP1',
    ICC_Profile  => 'APP2',
    FlashPix     => 'APP2',
    MPF          => 'APP2',
    Meta         => 'APP3',
    MetaIFD      => 'Meta',
    RMETA        => 'APP5',
    Ducky        => 'APP12',
    Photoshop    => 'APP13',
    Adobe        => 'APP14',
    IPTC         => 'Photoshop',
    MakerNotes   => ['ExifIFD', 'CIFF'], # (first parent is the default)
    CanonVRD     => 'MakerNotes', # (so VRDOffset will get updated)
    NikonCapture => 'MakerNotes', # (to allow delete by group)
    Comment      => 'COM',
);
my %dirMap = (
    JPEG => \%jpegMap,
    EXV  => \%jpegMap,
    TIFF => \%tiffMap,
    ORF  => \%tiffMap,
    RAW  => \%tiffMap,
    EXIF => \%exifMap,
);

# groups we are allowed to delete
# Notes:
# 1) these names must either exist in %dirMap, or be translated in InitWriteDirs())
# 2) any dependencies must be added to %excludeGroups
my @delGroups = qw(
    Adobe AFCP APP0 APP1 APP2 APP3 APP4 APP5 APP6 APP7 APP8 APP9 APP10 APP11 APP12
    APP13 APP14 APP15 CanonVRD CIFF Ducky EXIF ExifIFD File FlashPix FotoStation
    GlobParamIFD GPS ICC_Profile IFD0 IFD1 InteropIFD IPTC JFIF Jpeg2000 MakerNotes
    Meta MetaIFD MIE MPF NikonCapture PDF PDF-update PhotoMechanic Photoshop PNG
    PNG-pHYs PrintIM RMETA RSRC SubIFD Trailer XML XML-* XMP XMP-*
);
# family 2 group names that we can delete
my @delGroup2 = qw(
    Audio Author Camera Document ExifTool Image Location Other Preview Printing
    Time Video
);

# lookup for all valid family 2 groups (lower case)
my %family2groups = map { lc $_ => 1 } @delGroup2, 'Unknown';

# groups we don't delete when deleting all information
my $protectedGroups = '(IFD1|SubIFD|InteropIFD|GlobParamIFD|PDF-update|Adobe)';

# other group names of new tag values to remove when deleting an entire group
my %removeGroups = (
    IFD0    => [ 'EXIF', 'MakerNotes' ],
    EXIF    => [ 'MakerNotes' ],
    ExifIFD => [ 'MakerNotes', 'InteropIFD' ],
    Trailer => [ 'CanonVRD' ], #(because we can add back CanonVRD as a block)
);
# related family 0/1 groups in @delGroups (and not already in %jpegMap)
# that must be removed from delete list when excluding a group
my %excludeGroups = (
    EXIF         => [ qw(IFD0 IFD1 ExifIFD GPS MakerNotes GlobParamIFD InteropIFD PrintIM SubIFD) ],
    IFD0         => [ 'EXIF' ],
    IFD1         => [ 'EXIF' ],
    ExifIFD      => [ 'EXIF' ],
    GPS          => [ 'EXIF' ],
    MakerNotes   => [ 'EXIF' ],
    InteropIFD   => [ 'EXIF' ],
    GlobParamIFD => [ 'EXIF' ],
    PrintIM      => [ 'EXIF' ],
    CIFF         => [ 'MakerNotes' ],
    # technically correct, but very uncommon and not a good reason to avoid deleting trailer
  # IPTC         => [ qw(AFCP FotoStation Trailer) ],
    AFCP         => [ 'Trailer' ],
    FotoStation  => [ 'Trailer' ],
    CanonVRD     => [ 'Trailer' ],
    PhotoMechanic=> [ 'Trailer' ],
    MIE          => [ 'Trailer' ],
);
# translate (lower case) wanted group when writing for tags where group name may change
my %translateWantGroup = (
    ciff  => 'canonraw',
);
# group names to translate for writing
my %translateWriteGroup = (
    EXIF  => 'ExifIFD',
    Meta  => 'MetaIFD',
    File  => 'Comment',
    # any entry in this table causes the write group to be set from the
    # tag information instead of whatever the user specified...
    MIE   => 'MIE',
    APP14 => 'APP14',
);
# names of valid EXIF and Meta directories (lower case keys):
my %exifDirs = (
    gps          => 'GPS',
    exififd      => 'ExifIFD',
    subifd       => 'SubIFD',
    globparamifd => 'GlobParamIFD',
    interopifd   => 'InteropIFD',
    makernotes   => 'MakerNotes',
    previewifd   => 'PreviewIFD', # (in MakerNotes)
    metaifd      => 'MetaIFD', # Kodak APP3 Meta
);
# min/max values for integer formats
my %intRange = (
    'int8u'  => [0, 0xff],
    'int8s'  => [-0x80, 0x7f],
    'int16u' => [0, 0xffff],
    'int16uRev' => [0, 0xffff],
    'int16s' => [-0x8000, 0x7fff],
    'int32u' => [0, 0xffffffff],
    'int32s' => [-0x80000000, 0x7fffffff],
);
# lookup for file types with block-writable EXIF
my %blockExifTypes = map { $_ => 1 } qw(JPEG PNG JP2 MIE EXIF);

my $maxSegmentLen = 0xfffd;     # maximum length of data in a JPEG segment
my $maxXMPLen = $maxSegmentLen; # maximum length of XMP data in JPEG

# value separators when conversion list is used (in SetNewValue)
my %listSep = ( PrintConv => '; ?', ValueConv => ' ' );

# printConv hash keys to ignore when doing reverse lookup
my %ignorePrintConv = map { $_ => 1 } qw(OTHER BITMASK Notes);

#------------------------------------------------------------------------------
# Set tag value
# Inputs: 0) ExifTool object reference
#         1) tag key, tag name, or '*' (optionally prefixed by group name),
#            or undef to reset all previous SetNewValue() calls
#         2) new value (scalar, scalar ref or list ref), or undef to delete tag
#         3-N) Options:
#           Type => PrintConv, ValueConv or Raw - specifies value type
#           AddValue => true to add to list of existing values instead of overwriting
#           DelValue => true to delete this existing value value from a list
#           Group => family 0 or 1 group name (case insensitive)
#           Replace => 0, 1 or 2 - overwrite previous new values (2=reset)
#           Protected => bitmask to write tags with specified protections
#           EditOnly => true to only edit existing tags (don't create new tag)
#           EditGroup => true to only edit existing groups (don't create new group)
#           Shift => undef, 0, +1 or -1 - shift value if possible
#           NoFlat => treat flattened tags as 'unsafe'
#           NoShortcut => true to prevent looking up shortcut tags
#           ProtectSaved => protect existing new values with a save count greater than this
#           CreateGroups => [internal use] createGroups hash ref from related tags
#           ListOnly => [internal use] set only list or non-list tags
#           SetTags => [internal use] hash ref to return tagInfo refs of set tags
# Returns: number of tags set (plus error string in list context)
# Notes: For tag lists (like Keywords), call repeatedly with the same tag name for
#        each value in the list.  Internally, the new information is stored in
#        the following members of the $$self{NEW_VALUE}{$tagInfo} hash:
#           TagInfo - tag info ref
#           DelValue - list ref for values to delete
#           Value - list ref for values to add (not defined if deleting the tag)
#           IsCreating - must be set for the tag to be added for the standard file types,
#                        otherwise just changed if it already exists.  This may be
#                        overridden for file types with a PREFERRED metadata type.
#                        Set to 2 to create inidividual tags but not new groups
#           EditOnly - flag set if tag should never be created (regardless of file type).
#                      If this is set, then IsCreating must be false
#           CreateOnly - flag set if creating only (never edit existing tag)
#           CreateGroups - hash of all family 0 group names where tag may be created
#           WriteGroup - group name where information is being written (correct case)
#           WantGroup - group name as specified in call to function (case insensitive)
#           Next - pointer to next new value hash (if more than one)
#           NoReplace - set for List-type tag if value was created with Replace=0
#           AddBefore - number of list items added by a subsequent Replace=0 call
#           IsNVH - Flag indicating this is a new value hash
#           Shift - shift value
#           Save - counter used by SaveNewValues()/RestoreNewValues()
#           MAKER_NOTE_FIXUP - pointer to fixup if necessary for a maker note value
sub SetNewValue($;$$%)
{
    local $_;
    my ($self, $tag, $value, %options) = @_;
    my ($err, $tagInfo, $family);
    my $verbose = $$self{OPTIONS}{Verbose};
    my $out = $$self{OPTIONS}{TextOut};
    my $protected = $options{Protected} || 0;
    my $listOnly = $options{ListOnly};
    my $setTags = $options{SetTags};
    my $noFlat = $options{NoFlat};
    my $numSet = 0;

    unless (defined $tag) {
        delete $$self{NEW_VALUE};
        $$self{SAVE_COUNT} = 0;
        $$self{DEL_GROUP} = { };
        return 1;
    }
    # allow value to be scalar or list reference
    if (ref $value) {
        if (ref $value eq 'ARRAY') {
            # value is an ARRAY so it may have more than one entry
            # - set values both separately and as a combined string if there are more than one
            if (@$value > 1) {
                # set all list-type tags first
                my $replace = $options{Replace};
                my $noJoin;
                foreach (@$value) {
                    $noJoin = 1 if ref $_;
                    my ($n, $e) = SetNewValue($self, $tag, $_, %options, ListOnly => 1);
                    $err = $e if $e;
                    $numSet += $n;
                    delete $options{Replace}; # don't replace earlier values in list
                }
                return $numSet if $noJoin;  # don't join if list contains objects
                # and now set only non-list tags
                $value = join $$self{OPTIONS}{ListSep}, @$value;
                $options{Replace} = $replace;
                $listOnly = $options{ListOnly} = 0;
            } else {
                $value = $$value[0];
            }
        } elsif (ref $value eq 'SCALAR') {
            $value = $$value;
        }
    }
    # un-escape as necessary and make sure the Perl UTF-8 flag is OFF for the value
    # if perl is 5.6 or greater (otherwise our byte manipulations get corrupted!!)
    $self->Sanitize(\$value) if defined $value and not ref $value;

    # set group name in options if specified
    ($options{Group}, $tag) = ($1, $2) if $tag =~ /(.*):(.+)/;

    # allow trailing '#' for ValueConv value
    $options{Type} = 'ValueConv' if $tag =~ s/#$//;
    my $convType = $options{Type} || ($$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv');

    my (@wantGroup, $family2);
    my $wantGroup = $options{Group};
    if ($wantGroup) {
        foreach (split /:/, $wantGroup) {
            next unless length($_) and /^(\d+)?(.*)/; # separate family number and group name
            my ($f, $g) = ($1, lc $2);
            # save group/family unless '*' or 'all'
            push @wantGroup, [ $f, $g ] unless $g eq '*' or $g eq 'all';
            if (defined $f) {
                $f > 2 and return 0;      # only allow family 0, 1 or 2
                $family2 = 1 if $f == 2;  # set flag indicating family 2 was used
            } else {
                $family2 = 1 if $family2groups{$g};
            }
        }
        undef $wantGroup unless @wantGroup;
    }

    $tag =~ s/ .*//;    # convert from tag key to tag name if necessary
    $tag = '*' if lc($tag) eq 'all';    # use '*' instead of 'all'
#
# handle group delete
#
    while ($tag eq '*' and not defined $value and not $family2 and @wantGroup < 2) {
        # set groups to delete
        my (@del, $grp);
        my $remove = ($options{Replace} and $options{Replace} > 1);
        if ($wantGroup) {
            @del = grep /^$wantGroup$/i, @delGroups unless $wantGroup =~ /^XM[LP]-\*$/i;
            # remove associated groups when excluding from mass delete
            if (@del and $remove) {
                # remove associated groups in other family
                push @del, @{$excludeGroups{$del[0]}} if $excludeGroups{$del[0]};
                # remove upstream groups according to JPEG map
                my $dirName = $del[0];
                my @dirNames;
                for (;;) {
                    my $parent = $jpegMap{$dirName};
                    if (ref $parent) {
                        push @dirNames, @$parent;
                        $parent = pop @dirNames;
                    }
                    $dirName = $parent || shift @dirNames or last;
                    push @del, $dirName;    # exclude this too
                }
            }
            # allow MIE groups to be deleted by number,
            # and allow any XMP family 1 group to be deleted
            push @del, uc($wantGroup) if $wantGroup =~ /^(MIE\d+|XM[LP]-[-\w]*\w)$/i;
        } else {
            # push all groups plus '*', except the protected groups
            push @del, (grep !/^$protectedGroups$/, @delGroups), '*';
        }
        if (@del) {
            ++$numSet;
            my @donegrps;
            my $delGroup = $$self{DEL_GROUP};
            foreach $grp (@del) {
                if ($remove) {
                    my $didExcl;
                    if ($grp =~ /^(XM[LP])(-.*)?$/) {
                        my $x = $1;
                        if ($grp eq $x) {
                            # exclude all related family 1 groups too
                            foreach (keys %$delGroup) {
                                next unless /^(-?)$x-/;
                                push @donegrps, $_ unless $1;
                                delete $$delGroup{$_};
                            }
                        } elsif ($$delGroup{"$x-*"} and not $$delGroup{"-$grp"}) {
                            # must also exclude XMP or XML to prevent bulk delete
                            if ($$delGroup{$x}) {
                                push @donegrps, $x;
                                delete $$delGroup{$x};
                            }
                            # flag XMP/XML family 1 group for exclusion with leading '-'
                            $$delGroup{"-$grp"} = 1;
                            $didExcl = 1;
                        }
                    }
                    if (exists $$delGroup{$grp}) {
                        delete $$delGroup{$grp};
                    } else {
                        next unless $didExcl;
                    }
                } else {
                    $$delGroup{$grp} = 1;
                    # add flag for XMP/XML family 1 groups if deleting all XMP
                    if ($grp =~ /^XM[LP]$/) {
                        $$delGroup{"$grp-*"} = 1;
                        push @donegrps, "$grp-*";
                    }
                    # remove all of this group from previous new values
                    $self->RemoveNewValuesForGroup($grp);
                }
                push @donegrps, $grp;
            }
            if ($verbose > 1 and @donegrps) {
                @donegrps = sort @donegrps;
                my $msg = $remove ? 'Excluding from deletion' : 'Deleting tags in';
                print $out "  $msg: @donegrps\n";
            }
        } elsif (grep /^$wantGroup$/i, @delGroup2) {
            last;   # allow tags to be deleted by group2 name
        } else {
            $err = "Not a deletable group: $wantGroup";
        }
        # all done
        return ($numSet, $err) if wantarray;
        $err and warn "$err\n";
        return $numSet;
    }

    # initialize write/create flags
    my $createOnly;
    my $editOnly = $options{EditOnly};
    my $editGroup = $options{EditGroup};
    my $writeMode = $$self{OPTIONS}{WriteMode};
    if ($writeMode ne 'wcg') {
        $createOnly = 1 if $writeMode !~ /w/i;  # don't write existing tags
        if ($writeMode !~ /c/i) {
            return 0 if $createOnly;    # nothing to do unless writing existing tags
            $editOnly = 1;              # don't create new tags
        } elsif ($writeMode !~ /g/i) {
            $editGroup = 1;             # don't create new groups
        }
    }
#
# get list of tags we want to set
#
    my $origTag = $tag;
    my @matchingTags = FindTagInfo($tag);
    until (@matchingTags) {
        my $langCode;
        # allow language suffix of form "-en_CA" or "-<rfc3066>" on tag name
        if ($tag =~ /^([?*\w]+)-([a-z]{2})(_[a-z]{2})$/i or # MIE
            $tag =~ /^([?*\w]+)-([a-z]{2,3}|[xi])(-[a-z\d]{2,8}(-[a-z\d]{1,8})*)?$/i) # XMP/PNG
        {
            $tag = $1;
            # normalize case of language codes
            $langCode = lc($2);
            $langCode .= (length($3) == 3 ? uc($3) : lc($3)) if $3;
            my @newMatches = FindTagInfo($tag);
            foreach $tagInfo (@newMatches) {
                # only allow language codes in tables which support them
                next unless $$tagInfo{Table};
                my $langInfoProc = $$tagInfo{Table}{LANG_INFO} or next;
                my $langInfo = &$langInfoProc($tagInfo, $langCode);
                push @matchingTags, $langInfo if $langInfo;
            }
            last if @matchingTags;
        } elsif (not $options{NoShortcut}) {
            # look for a shortcut or alias
            require Image::ExifTool::Shortcuts;
            my ($match) = grep /^\Q$tag\E$/i, keys %Image::ExifTool::Shortcuts::Main;
            undef $err;
            if ($match) {
                $options{NoShortcut} = 1;
                foreach $tag (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
                    my ($n, $e) = $self->SetNewValue($tag, $value, %options);
                    $numSet += $n;
                    $e and $err = $e;
                }
                undef $err if $numSet;  # no error if any set successfully
                return ($numSet, $err) if wantarray;
                $err and warn "$err\n";
                return $numSet;
            }
        }
        unless ($listOnly) {
            if (not TagExists($tag)) {
                $err = "Tag '$origTag' does not exist";
                $err .= ' or has a bad language code' if $origTag =~ /-/;
            } elsif ($langCode) {
                $err = "Tag '$tag' does not support alternate languages";
            } elsif ($wantGroup) {
                $err = "Sorry, $wantGroup:$origTag doesn't exist or isn't writable";
            } else {
                $err = "Sorry, $origTag is not writable";
            }
            $verbose > 2 and print $out "$err\n";
        }
        # all done
        return ($numSet, $err) if wantarray;
        $err and warn "$err\n";
        return $numSet;
    }
    # get group name that we're looking for
    my $foundMatch = 0;
    my ($ifdName, $mieGroup, $movGroup, $fg);
    # set family 1 group names
    foreach $fg (@wantGroup) {
        next if $$fg[0] and $$fg[0] != 1;
        $_ = $$fg[1];
        # set $ifdName if this group is a valid IFD or SubIFD name
        if (/^IFD(\d+)$/i) {
            $ifdName = "IFD$1";
        } elsif (/^SubIFD(\d+)$/i) {
            $ifdName = "SubIFD$1";
        } elsif (/^Version(\d+)$/i) {
            $ifdName = "Version$1"; # Sony IDC VersionIFD
        } elsif (/^Track(\d+)$/i) {
            $movGroup = "Track$1";  # QuickTime track
        } elsif (/^MIE(\d*-?)(\w+)$/i) {
            $mieGroup = "MIE$1" . ucfirst(lc($2));
        } else {
            $ifdName = $exifDirs{$_} if $exifDirs{$_};
            if (not $ifdName and /^XMP\b/i) {
                # must load XMP table to set group1 names
                my $table = GetTagTable('Image::ExifTool::XMP::Main');
                my $writeProc = $$table{WRITE_PROC};
                $writeProc and &$writeProc();
            }
        }
    }
#
# determine the groups for all tags found, and the tag with
# the highest priority group
#
    my (@tagInfoList, @writeAlsoList, %writeGroup, %preferred, %tagPriority);
    my (%avoid, $wasProtected, $noCreate, %highestPriority);

TAG: foreach $tagInfo (@matchingTags) {
        $tag = $$tagInfo{Name};     # get tag name for warnings
        my $lcTag = lc $tag;        # get lower-case tag name for use in variables
        # initialize highest priority if we are starting a new tag
        $highestPriority{$lcTag} = -999 unless defined $highestPriority{$lcTag};
        my ($priority, $writeGroup);
        if ($wantGroup) {
            my @grp = $self->GetGroup($tagInfo);
            foreach $fg (@wantGroup) {
                my ($fam, $lcWant) = @$fg;
                $lcWant = $translateWantGroup{$lcWant} if $translateWantGroup{$lcWant};
                # only set tag in specified group
                if (not defined $fam) {
                    next if $lcWant eq lc $grp[0] or $lcWant eq lc $grp[2];
                } elsif ($fam != 1 and not $$tagInfo{AllowGroup}) {
                    next if $lcWant eq lc $grp[$fam];
                    next TAG;   # wrong group
                }
                # handle family 1 groups specially
                if ($grp[0] eq 'EXIF' or $grp[0] eq 'SonyIDC') {
                    next TAG unless $ifdName and $lcWant eq lc($ifdName);
                    # can't yet write PreviewIFD tags
                    $ifdName eq 'PreviewIFD' and ++$foundMatch, next TAG;
                    $writeGroup = $ifdName;  # write to the specified IFD
                } elsif ($grp[0] eq 'QuickTime' and $grp[1] eq 'Track#') {
                    next TAG unless $movGroup and $lcWant eq lc($movGroup);
                    $writeGroup = $movGroup;
                } elsif ($grp[0] eq 'MIE') {
                    next TAG unless $mieGroup and $lcWant eq lc($mieGroup);
                    $writeGroup = $mieGroup; # write to specific MIE group
                    # set specific write group with document number if specified
                    if ($writeGroup =~ /^MIE\d+$/ and $$tagInfo{Table}{WRITE_GROUP}) {
                        $writeGroup = $$tagInfo{Table}{WRITE_GROUP};
                        $writeGroup =~ s/^MIE/$mieGroup/;
                    }
                } elsif (not $$tagInfo{AllowGroup} or $lcWant !~ /^$$tagInfo{AllowGroup}$/i) {
                    # allow group1 name to be specified
                    next TAG unless $lcWant eq lc $grp[1];
                }
            }
            $writeGroup or $writeGroup = $grp[0];
            $priority = 1000; # highest priority since group was specified
        }
        ++$foundMatch;
        # must do a dummy call to the write proc to autoload write package
        # before checking Writable flag
        my $table = $$tagInfo{Table};
        my $writeProc = $$table{WRITE_PROC};
        # load source table if this was a user-defined table
        if ($$table{SRC_TABLE}) {
            my $src = GetTagTable($$table{SRC_TABLE});
            $writeProc = $$src{WRITE_PROC} unless $writeProc;
        }
        next unless $writeProc and &$writeProc();
        # must still check writable flags in case of UserDefined tags
        my $writable = $$tagInfo{Writable};
        next unless $writable or ($$table{WRITABLE} and
            not defined $writable and not $$tagInfo{SubDirectory});
        # set specific write group (if we didn't already)
        if (not $writeGroup or $translateWriteGroup{$writeGroup}) {
            # use default write group
            $writeGroup = $$tagInfo{WriteGroup} || $$tagInfo{Table}{WRITE_GROUP};
            # use group 0 name if no WriteGroup specified
            my $group0 = $self->GetGroup($tagInfo, 0);
            $writeGroup or $writeGroup = $group0;
            # get priority for this group
            unless ($priority) {
                $priority = $$self{WRITE_PRIORITY}{lc($writeGroup)};
                unless ($priority) {
                    $priority = $$self{WRITE_PRIORITY}{lc($group0)} || 0;
                }
            }
        }
        # don't write tag if protected
        my $prot = $$tagInfo{Protected};
        $prot = 1 if $noFlat and defined $$tagInfo{Flat};
        if ($prot) {
            $prot &= ~$protected;
            if ($prot) {
                my %lkup = ( 1=>'unsafe', 2=>'protected', 3=>'unsafe and protected');
                $wasProtected = $lkup{$prot};
                if ($verbose > 1) {
                    my $wgrp1 = $self->GetWriteGroup1($tagInfo, $writeGroup);
                    print $out "Sorry, $wgrp1:$tag is $wasProtected for writing\n";
                }
                next;
            }
        }
        # set priority for this tag
        $tagPriority{$tagInfo} = $priority;
        if ($priority > $highestPriority{$lcTag}) {
            $highestPriority{$lcTag} = $priority;
            $preferred{$lcTag} = { $tagInfo => 1 };
            $avoid{$lcTag} = $$tagInfo{Avoid} ? 1 : 0;
        } elsif ($priority == $highestPriority{$lcTag}) {
            # create all tags with highest priority
            $preferred{$lcTag}{$tagInfo} = 1;
            ++$avoid{$lcTag} if $$tagInfo{Avoid};
        }
        if ($$tagInfo{WriteAlso}) {
            # store WriteAlso tags separately so we can set them first
            push @writeAlsoList, $tagInfo;
        } else {
            push @tagInfoList, $tagInfo;
        }
        $writeGroup{$tagInfo} = $writeGroup;
    }
    # sort tag info list in reverse order of priority (higest number last)
    # so we get the highest priority error message in the end
    @tagInfoList = sort { $tagPriority{$a} <=> $tagPriority{$b} } @tagInfoList;
    # must write any tags which also write other tags first
    unshift @tagInfoList, @writeAlsoList if @writeAlsoList;

    # check priorities for each set of tags we are writing
    my $lcTag;
    foreach $lcTag (keys %preferred) {
        # don't create tags with priority 0 if group priorities are set
        if ($preferred{$lcTag} and $highestPriority{$lcTag} == 0 and
            %{$$self{WRITE_PRIORITY}})
        {
            delete $preferred{$lcTag}
        }
        # avoid creating tags with 'Avoid' flag set if there are other alternatives
        if ($avoid{$lcTag} and $preferred{$lcTag}) {
            if ($avoid{$lcTag} < scalar(keys %{$preferred{$lcTag}})) {
                # just remove the 'Avoid' tags since there are other preferred tags
                foreach $tagInfo (@tagInfoList) {
                    next unless $lcTag eq lc $$tagInfo{Name};
                    delete $preferred{$lcTag}{$tagInfo} if $$tagInfo{Avoid};
                }
            } elsif ($highestPriority{$lcTag} < 1000) {
                # look for another priority tag to create instead
                my $nextHighest = 0;
                my @nextBestTags;
                foreach $tagInfo (@tagInfoList) {
                    next unless $lcTag eq lc $$tagInfo{Name};
                    my $priority = $tagPriority{$tagInfo} or next;
                    next if $priority == $highestPriority{$lcTag};
                    next if $priority < $nextHighest;
                    next if $$tagInfo{Avoid} or $$tagInfo{Permanent};
                    next if $writeGroup{$tagInfo} eq 'MakerNotes';
                    if ($nextHighest < $priority) {
                        $nextHighest = $priority;
                        undef @nextBestTags;
                    }
                    push @nextBestTags, $tagInfo;
                }
                if (@nextBestTags) {
                    # change our preferred tags to the next best tags
                    delete $preferred{$lcTag};
                    foreach $tagInfo (@nextBestTags) {
                        $preferred{$lcTag}{$tagInfo} = 1;
                    }
                }
            }
        }
    }
#
# generate new value hash for each tag
#
    my ($prioritySet, $createGroups, %alsoWrote);

    delete $$self{CHECK_WARN};  # reset CHECK_PROC warnings

    # loop through all valid tags to find the one(s) to write
    foreach $tagInfo (@tagInfoList) {
        next if $alsoWrote{$tagInfo};   # don't rewrite tags we already wrote
        # only process List or non-List tags if specified
        next if defined $listOnly and ($listOnly xor $$tagInfo{List});
        my $noConv;
        my $writeGroup = $writeGroup{$tagInfo};
        my $permanent = $$tagInfo{Permanent};
        $writeGroup eq 'MakerNotes' and $permanent = 1 unless defined $permanent;
        my $wgrp1 = $self->GetWriteGroup1($tagInfo, $writeGroup);
        $tag = $$tagInfo{Name};     # get tag name for warnings
        my $pref = $preferred{lc $tag} || { };
        my $shift = $options{Shift};
        my $addValue = $options{AddValue};
        if (defined $shift) {
            # (can't currently shift list-type tags)
            if (not $$tagInfo{List}) {
                unless ($shift) {
                    # set shift according to AddValue/DelValue
                    $shift = 1 if $addValue;
                    if ($options{DelValue}) {
                        # can shift a date/time with -=, but this is
                        # a conditional delete operation for other tags
                        $shift = -1 if $$tagInfo{Shift} and $$tagInfo{Shift} eq 'Time';
                    }
                }
                if ($shift and (not defined $value or not length $value)) {
                    # (now allow -= to be used for shiftable tag - v8.05)
                    #$err = "No value for time shift of $wgrp1:$tag";
                    #$verbose > 2 and print $out "$err\n";
                    #next;
                    undef $shift;
                }
            } elsif ($shift) {
                $err = "$wgrp1:$tag is not shiftable";
                $verbose > 2 and print $out "$err\n";
                next;
            }
        }
        my $val = $value;
        if (defined $val) {
            # check to make sure this is a List or Shift tag if adding
            if ($addValue and not ($shift or $$tagInfo{List})) {
                if ($addValue eq '2') {
                    undef $addValue;    # quitely reset this option
                } else {
                    $err = "Can't add $wgrp1:$tag (not a List type)";
                    $verbose > 2 and print $out "$err\n";
                    next;
                }
            }
            if ($shift) {
                if ($$tagInfo{Shift} and $$tagInfo{Shift} eq 'Time') {
                    # add '+' or '-' prefix to indicate shift direction
                    $val = ($shift > 0 ? '+' : '-') . $val;
                    # check the shift for validity
                    require 'Image/ExifTool/Shift.pl';
                    my $err2 = CheckShift($$tagInfo{Shift}, $val);
                    if ($err2) {
                        $err = "$err2 for $wgrp1:$tag";
                        $verbose > 2 and print $out "$err\n";
                        next;
                    }
                } elsif (IsFloat($val)) {
                    $val *= $shift;
                } else {
                    $err = "Shift value for $wgrp1:$tag is not a number";
                    $verbose > 2 and print $out "$err\n";
                    next;
                }
                $noConv = 1;    # no conversions if shifting tag
            } elsif (not length $val and $options{DelValue}) {
                $noConv = 1;    # no conversions for deleting empty value
            } elsif (ref $val eq 'HASH' and not $$tagInfo{Struct}) {
                $err = "Can't write a structure to $wgrp1:$tag";
                $verbose > 2 and print $out "$err\n";
                next;
            }
        } elsif ($permanent) {
            # can't delete permanent tags, so set them to DelValue or empty string instead
            if (defined $$tagInfo{DelValue}) {
                $val = $$tagInfo{DelValue};
                $noConv = 1;    # DelValue is the raw value, so no conversion necessary
            } else {
                $val = '';
            }
        } elsif ($addValue or $options{DelValue}) {
            $err = "No value to add or delete in $wgrp1:$tag";
            $verbose > 2 and print $out "$err\n";
            next;
        } else {
            if ($$tagInfo{DelCheck}) {
                #### eval DelCheck ($self, $tagInfo, $wantGroup)
                my $err2 = eval $$tagInfo{DelCheck};
                $@ and warn($@), $err2 = 'Error evaluating DelCheck';
                if (defined $err2) {
                    # (allow other tags to be set using DelCheck as a hook)
                    $err2 or goto WriteAlso; # GOTO!
                    $err2 .= ' for' unless $err2 =~ /delete$/;
                    $err = "$err2 $wgrp1:$tag";
                    $verbose > 2 and print $out "$err\n";
                    next;
                }
            }
            $noConv = 1;    # value is not defined, so don't do conversion
        }
        # apply inverse PrintConv and ValueConv conversions
        # save ValueConv setting for use in ConvInv()
        unless ($noConv) {
            # set default conversion type used by ConvInv() and CHECK_PROC routines
            $$self{ConvType} = $convType;
            my $e;
            ($val,$e) = $self->ConvInv($val,$tagInfo,$tag,$wgrp1,$$self{ConvType},$wantGroup);
            if (defined $e) {
                # empty error string causes error to be ignored without setting the value
                $e or goto WriteAlso; # GOTO!
                $err = $e;
            }
        }
        if (not defined $val and defined $value) {
            # if value conversion failed, we must still add a NEW_VALUE
            # entry for this tag it it was a DelValue
            next unless $options{DelValue};
            $val = 'xxx never delete xxx';
        }
        $$self{NEW_VALUE} or $$self{NEW_VALUE} = { };
        if ($options{Replace}) {
            # delete the previous new value
            $self->GetNewValueHash($tagInfo, $writeGroup, 'delete', $options{ProtectSaved});
            # also delete related tag previous new values
            if ($$tagInfo{WriteAlso}) {
                my $wtag;
                foreach $wtag (keys %{$$tagInfo{WriteAlso}}) {
                    my ($n,$e) = $self->SetNewValue($wtag, undef, Replace=>2);
                    $numSet += $n;
                }
            }
            $options{Replace} == 2 and ++$numSet, next;
        }

        if (defined $val) {
            # we are editing this tag, so create a NEW_VALUE hash entry
            my $nvHash = $self->GetNewValueHash($tagInfo, $writeGroup, 'create', $options{ProtectSaved});
            # ignore new values protected with ProtectSaved
            $nvHash or ++$numSet, next; # (increment $numSet to avoid warning)
            $$nvHash{NoReplace} = 1 if $$tagInfo{List} and not $options{Replace};
            $$nvHash{WantGroup} = $wantGroup;
            $$nvHash{EditOnly} = 1 if $editOnly;
            # save maker note information if writing maker notes
            if ($$tagInfo{MakerNotes}) {
                $$nvHash{MAKER_NOTE_FIXUP} = $$self{MAKER_NOTE_FIXUP};
            }
            if ($createOnly) {  # create only (never edit)
                # empty item in DelValue list to never edit existing value
                $$nvHash{DelValue} = [ '' ];
                $$nvHash{CreateOnly} = 1;
            } elsif ($options{DelValue} or $addValue or $shift) {
                # flag any AddValue or DelValue by creating the DelValue list
                $$nvHash{DelValue} or $$nvHash{DelValue} = [ ];
                if ($shift) {
                    # add shift value to list
                    $$nvHash{Shift} = $val;
                } elsif ($options{DelValue}) {
                    # don't create if we are replacing a specific value
                    $$nvHash{IsCreating} = 0 unless $val eq '' or $$tagInfo{List};
                    # add delete value to list
                    push @{$$nvHash{DelValue}}, ref $val eq 'ARRAY' ? @$val : $val;
                    if ($verbose > 1) {
                        my $verb = $permanent ? 'Replacing' : 'Deleting';
                        my $fromList = $$tagInfo{List} ? ' from list' : '';
                        my @vals = (ref $val eq 'ARRAY' ? @$val : $val);
                        foreach (@vals) {
                            if (ref $_ eq 'HASH') {
                                require 'Image/ExifTool/XMPStruct.pl';
                                $_ = Image::ExifTool::XMP::SerializeStruct($_);
                            }
                            print $out "$verb $wgrp1:$tag$fromList if value is '$_'\n";
                        }
                    }
                }
            }
            # set priority flag to add only the high priority info
            # (will only create the priority tag if it doesn't exist,
            #  others get changed only if they already exist)
            if ($$pref{$tagInfo} or $$tagInfo{Table}{PREFERRED}) {
                if ($permanent or $shift) {
                    # don't create permanent or Shift-ed tag but define IsCreating
                    # so we know that it is the preferred tag
                    $$nvHash{IsCreating} = 0;
                } elsif (($$tagInfo{List} and not $options{DelValue}) or
                         not ($$nvHash{DelValue} and @{$$nvHash{DelValue}}) or
                         # also create tag if any DelValue value is empty ('')
                         grep(/^$/,@{$$nvHash{DelValue}}))
                {
                    $$nvHash{IsCreating} = $editOnly ? 0 : ($editGroup ? 2 : 1);
                    # add to hash of groups where this tag is being created
                    $createGroups or $createGroups = $options{CreateGroups} || { };
                    $$createGroups{$self->GetGroup($tagInfo, 0)} = 1;
                    $$nvHash{CreateGroups} = $createGroups;
                }
            }
            if ($$nvHash{IsCreating}) {
                if (%{$$self{DEL_GROUP}}) {
                    my ($grp, @grps);
                    foreach $grp (keys %{$$self{DEL_GROUP}}) {
                        next if $$self{DEL_GROUP}{$grp} == 2;
                        # set flag indicating tags were written after this group was deleted
                        $$self{DEL_GROUP}{$grp} = 2;
                        push @grps, $grp;
                    }
                    if ($verbose > 1 and @grps) {
                        @grps = sort @grps;
                        print $out "  Writing new tags after deleting groups: @grps\n";
                    }
                }
            } elsif ($createOnly) {
                $noCreate = $permanent ? 'permanent' : ($$tagInfo{Avoid} ? 'avoided' : '');
                $noCreate or $noCreate = $shift ? 'shifting' : 'not preferred';
                $verbose > 2 and print $out "Not creating $wgrp1:$tag ($noCreate)\n";
                next;   # nothing to do (not creating and not editing)
            }
            if ($shift or not $options{DelValue}) {
                $$nvHash{Value} or $$nvHash{Value} = [ ];
                if (not $$tagInfo{List}) {
                    # not a List tag -- overwrite existing value
                    $$nvHash{Value}[0] = $val;
                } elsif (defined $$nvHash{AddBefore} and @{$$nvHash{Value}} >= $$nvHash{AddBefore}) {
                    # values from a later argument have been added (ie. Replace=0)
                    # to this list, so the new values should come before these
                    splice @{$$nvHash{Value}}, -$$nvHash{AddBefore}, 0, ref $val eq 'ARRAY' ? @$val : $val;
                } else {
                    # add at end of existing list
                    push @{$$nvHash{Value}}, ref $val eq 'ARRAY' ? @$val : $val;
                }
                if ($verbose > 1) {
                    my $ifExists = $$nvHash{IsCreating} ? ( $createOnly ?
                                  ($$nvHash{IsCreating} == 2 ?
                                    " if $writeGroup exists and tag doesn't" :
                                    " if tag doesn't exist") :
                                  ($$nvHash{IsCreating} == 2 ? " if $writeGroup exists" : '')) :
                                  (($$nvHash{DelValue} and @{$$nvHash{DelValue}}) ?
                                    ' if tag was deleted' : ' if tag exists');
                    my $verb = ($shift ? 'Shifting' : ($addValue ? 'Adding' : 'Writing'));
                    print $out "$verb $wgrp1:$tag$ifExists\n";
                }
            }
        } elsif ($permanent) {
            $err = "Can't delete Permanent tag $wgrp1:$tag";
            $verbose > 1 and print $out "$err\n";
            next;
        } elsif ($addValue or $options{DelValue}) {
            $verbose > 1 and print $out "Adding/Deleting nothing does nothing\n";
            next;
        } else {
            # create empty new value hash entry to delete this tag
            $self->GetNewValueHash($tagInfo, $writeGroup, 'delete');
            my $nvHash = $self->GetNewValueHash($tagInfo, $writeGroup, 'create');
            $$nvHash{WantGroup} = $wantGroup;
            $verbose > 1 and print $out "Deleting $wgrp1:$tag\n";
        }
        $$setTags{$tagInfo} = 1 if $setTags;
        $prioritySet = 1 if $$pref{$tagInfo};
WriteAlso:
        ++$numSet;
        # also write related tags
        my $writeAlso = $$tagInfo{WriteAlso};
        if ($writeAlso) {
            my ($wtag, $n);
            local $SIG{'__WARN__'} = \&SetWarning;
            foreach $wtag (keys %$writeAlso) {
                my %opts = (
                    Type => 'ValueConv',
                    Protected => $protected | 0x02,
                    AddValue => $addValue,
                    DelValue => $options{DelValue},
                    Replace => $options{Replace}, # handle lists properly
                    CreateGroups => $createGroups,
                    SetTags => \%alsoWrote, # remember tags already written
                );
                undef $evalWarning;
                #### eval WriteAlso ($val)
                my $v = eval $$writeAlso{$wtag};
                $@ and $evalWarning = $@;
                unless ($evalWarning) {
                    ($n,$evalWarning) = $self->SetNewValue($wtag, $v, %opts);
                    $numSet += $n;
                    # count this as being set if any related tag is set
                    $prioritySet = 1 if $n and $$pref{$tagInfo};
                }
                if ($evalWarning and (not $err or $verbose > 2)) {
                    my $str = CleanWarning();
                    if ($str) {
                        $str .= " for $wtag" unless $str =~ / for [-\w:]+$/;
                        $str .= " in $wgrp1:$tag (WriteAlso)";
                        $err or $err = $str;
                        print $out "$str\n" if $verbose > 2;
                    }
                }
            }
        }
    }
    # print warning if we couldn't set our priority tag
    if (defined $err and not $prioritySet) {
        warn "$err\n" if $err and not wantarray;
    } elsif (not $numSet) {
        my $pre = $wantGroup ? ($ifdName || $wantGroup) . ':' : '';
        if ($wasProtected) {
            $verbose = 0;   # we already printed this verbose message
            unless ($options{Replace} and $options{Replace} == 2) {
                $err = "Sorry, $pre$tag is $wasProtected for writing";
            }
        } elsif (not $listOnly) {
            if ($origTag =~ /[?*]/) {
                if ($noCreate) {
                    $err = "No tags matching 'pre$origTag' will be created";
                    $verbose = 0;   # (already printed)
                } elsif ($foundMatch) {
                    $err = "Sorry, no writable tags matching '$pre$origTag'";
                } else {
                    $err = "No matching tags for '$pre$origTag'";
                }
            } elsif ($noCreate) {
                $err = "Not creating $pre$tag";
                $verbose = 0;   # (already printed)
            } elsif ($foundMatch) {
                $err = "Sorry, $pre$tag is not writable";
            } else {
                $err = "Tag '$pre$tag' does not exist";
            }
        }
        if ($err) {
            $verbose > 2 and print $out "$err\n";
            warn "$err\n" unless wantarray;
        }
    } elsif ($$self{CHECK_WARN}) {
        $err = $$self{CHECK_WARN};
        $verbose > 2 and print $out "$err\n";
    } elsif ($err and not $verbose) {
        undef $err;
    }
    return ($numSet, $err) if wantarray;
    return $numSet;
}

#------------------------------------------------------------------------------
# set new values from information in specified file
# Inputs: 0) ExifTool object reference, 1) source file name or reference, etc
#         2-N) List of tags to set (or all if none specified), or reference(s) to
#         hash for options to pass to SetNewValue.  The Replace option defaults
#         to 1 for SetNewValuesFromFile -- set this to 0 to allow multiple tags
#         to be copied to a list
# Returns: Hash of information set successfully (includes Warning or Error messages)
# Notes: Tag names may contain a group prefix, a leading '-' to exclude from copy,
#        and/or a trailing '#' to copy the ValueConv value.  The tag name '*' may
#        be used to represent all tags in a group.  An optional destination tag
#        may be specified with '>DSTTAG' ('DSTTAG<TAG' also works, but in this
#        case the source tag may also be an expression involving tag names).
sub SetNewValuesFromFile($$;@)
{
    local $_;
    my ($self, $srcFile, @setTags) = @_;
    my ($key, $tag, @exclude, @reqTags);

    # get initial SetNewValuesFromFile options
    my %opts = ( Replace => 1 );    # replace existing list items by default
    while (ref $setTags[0] eq 'HASH') {
        $_ = shift @setTags;
        foreach $key (keys %$_) {
            $opts{$key} = $$_{$key};
        }
    }
    # expand shortcuts
    @setTags and ExpandShortcuts(\@setTags);
    my $srcExifTool = new Image::ExifTool;
    # set flag to indicate we are being called from inside SetNewValuesFromFile()
    $$srcExifTool{TAGS_FROM_FILE} = 1;
    # synchronize and increment the file sequence number
    $$srcExifTool{FILE_SEQUENCE} = $$self{FILE_SEQUENCE}++;
    # set options for our extraction tool
    my $options = $$self{OPTIONS};
    # copy both structured and flattened tags by default (but flattened tags are "unsafe")
    my $structOpt = defined $$options{Struct} ? $$options{Struct} : 2;
    # copy structures only if no tags specified (since flattened tags are "unsafe")
    $structOpt = 1 if $structOpt eq '2' and not @setTags;
    # +------------------------------------------+
    # ! DON'T FORGET!!  Must consider each new   !
    # ! option to decide how it is handled here. !
    # +------------------------------------------+
    $srcExifTool->Options(
        Binary          => 1,
        Charset         => $$options{Charset},
        CharsetEXIF     => $$options{CharsetEXIF},
        CharsetFileName => $$options{CharsetFileName},
        CharsetID3      => $$options{CharsetID3},
        CharsetIPTC     => $$options{CharsetIPTC},
        CharsetPhotoshop=> $$options{CharsetPhotoshop},
        Composite       => $$options{Composite},
        CoordFormat     => $$options{CoordFormat} || '%d %d %.8f', # copy coordinates at high resolution unless otherwise specified
        DateFormat      => $$options{DateFormat},
        Duplicates      => 1,
        Escape          => $$options{Escape},
      # Exclude set below
        ExtendedXMP     => $$options{ExtendedXMP},
        ExtractEmbedded => $$options{ExtractEmbedded},
        FastScan        => $$options{FastScan},
        Filter          => $$options{Filter},
        FixBase         => $$options{FixBase},
        GlobalTimeShift => $$options{GlobalTimeShift},
        IgnoreMinorErrors=>$$options{IgnoreMinorErrors},
        Lang            => $$options{Lang},
        LargeFileSupport=> $$options{LargeFileSupport},
        List            => 1,
        ListItem        => $$options{ListItem},
        ListSep         => $$options{ListSep},
        MakerNotes      => $$options{FastScan} && $$options{FastScan} > 1 ? undef : 1,
        MDItemTags      => $$options{MDItemTags},
        MissingTagValue => $$options{MissingTagValue},
        NoPDFList       => $$options{NoPDFList},
        Password        => $$options{Password},
        PrintConv       => $$options{PrintConv},
        QuickTimeUTC    => $$options{QuickTimeUTC},
        RequestAll      => 1, # (is this still necessary now that RequestTags are being set?)
        RequestTags     => $$options{RequestTags},
        ScanForXMP      => $$options{ScanForXMP},
        StrictDate      => 1,
        Struct          => $structOpt,
        SystemTags      => $$options{SystemTags},
        Unknown         => $$options{Unknown},
        UserParam       => $$options{UserParam},
        XMPAutoConv     => $$options{XMPAutoConv},
    );
    foreach $tag (@setTags) {
        next if ref $tag;
        if ($tag =~ /^-(.*)/) {
            # avoid extracting tags that are excluded
            push @exclude, $1;
            next;
        }
        # add specified tags to list of requested tags
        $_ = $tag;
        if (/(.+?)\s*(>|<)\s*(.+)/) {
            if ($2 eq '>') {
                $_ = $1;
            } else {
                $_ = $3;
                /\$/ and push(@reqTags, /\$\{?(?:[-\w]+:)*([-\w?*]+)/g), next;
            }
        }
        push @reqTags, $2 if /(^|:)([-\w?*]+)#?$/;
    }
    if (@exclude) {
        ExpandShortcuts(\@exclude, 1);
        $srcExifTool->Options(Exclude => \@exclude);
    }
    $srcExifTool->Options(RequestTags => \@reqTags) if @reqTags;
    my $printConv = $$options{PrintConv};
    if ($opts{Type}) {
        # save source type separately because it may be different than dst Type
        $opts{SrcType} = $opts{Type};
        # override PrintConv option with initial Type if given
        $printConv = ($opts{Type} eq 'PrintConv' ? 1 : 0);
        $srcExifTool->Options(PrintConv => $printConv);
    }
    my $srcType = $printConv ? 'PrintConv' : 'ValueConv';

    # get all tags from source file (including MakerNotes block)
    my $info = $srcExifTool->ImageInfo($srcFile);
    return $info if $$info{Error} and $$info{Error} eq 'Error opening file';
    delete $$srcExifTool{VALUE}{Error}; # delete so we can check this later

    # sort tags in reverse order so we get priority tag last
    my @tags = reverse sort keys %$info;
#
# simply transfer all tags from source image if no tags specified
#
    unless (@setTags) {
        # transfer maker note information to this object
        $$self{MAKER_NOTE_FIXUP} = $$srcExifTool{MAKER_NOTE_FIXUP};
        $$self{MAKER_NOTE_BYTE_ORDER} = $$srcExifTool{MAKER_NOTE_BYTE_ORDER};
        foreach $tag (@tags) {
            # don't try to set errors or warnings
            next if $tag =~ /^(Error|Warning)\b/;
            # get approprite value type if necessary
            if ($opts{SrcType} and $opts{SrcType} ne $srcType) {
                $$info{$tag} = $srcExifTool->GetValue($tag, $opts{SrcType});
            }
            # set value for this tag
            my ($n, $e) = $self->SetNewValue($tag, $$info{$tag}, %opts);
            # delete this tag if we could't set it
            $n or delete $$info{$tag};
        }
        return $info;
    }
#
# transfer specified tags in the proper order
#
    # 1) loop through input list of tags to set, and build @setList
    my (@setList, $set, %setMatches, $t);
    foreach $t (@setTags) {
        if (ref $t eq 'HASH') {
            # update current options
            foreach $key (keys %$t) {
                $opts{$key} = $$t{$key};
            }
            next;
        }
        # make a copy of the current options for this setTag
        # (also use this hash to store expression and wildcard flags, EXPR and WILD)
        my $opts = { %opts };
        $tag = lc $t;   # change tag/group names to all lower case
        my (@fg, $grp, $dst, $dstGrp, $dstTag, $isExclude);
        # handle redirection to another tag
        if ($tag =~ /(.+?)\s*(>|<)\s*(.+)/) {
            $dstGrp = '';
            my $opt;
            if ($2 eq '>') {
                ($tag, $dstTag) = ($1, $3);
                # flag add and delete (eg. '+<' and '-<') redirections
                $opt = $1 if $tag =~ s/\s*([-+])$// or $dstTag =~ s/^([-+])\s*//;
            } else {
                ($tag, $dstTag) = ($3, $1);
                $opt = $1 if $dstTag =~ s/\s*([-+])$//;
                # handle expressions
                if ($tag =~ /\$/) {
                    $tag = $t;  # restore original case
                    # recover leading whitespace (except for initial single space)
                    $tag =~ s/(.+?)\s*(>|<) ?//;
                    $$opts{EXPR} = 1; # flag this expression
                } else {
                    $opt = $1 if $tag =~ s/^([-+])\s*//;
                }
            }
            # validate tag name(s)
            $$opts{EXPR} or ValidTagName($tag) or $self->Warn("Invalid tag name '$tag'"), next;
            ValidTagName($dstTag) or $self->Warn("Invalid tag name '$dstTag'"), next;
            # translate '+' and '-' to appropriate SetNewValue option
            if ($opt) {
                $$opts{{ '+' => 'AddValue', '-' => 'DelValue' }->{$opt}} = 1;
                $$opts{Shift} = 0;  # shift if shiftable
            }
            ($dstGrp, $dstTag) = ($1, $2) if $dstTag =~ /(.*):(.+)/;
            # ValueConv may be specified separately on the destination with '#'
            $$opts{Type} = 'ValueConv' if $dstTag =~ s/#$//;
            # replace tag name of 'all' with '*'
            $dstTag = '*' if $dstTag eq 'all';
        }
        unless ($$opts{EXPR}) {
            $isExclude = ($tag =~ s/^-//);
            if ($tag =~ /(.*):(.+)/) {
                ($grp, $tag) = ($1, $2);
                foreach (split /:/, $grp) {
                    # save family/groups in list (ignoring 'all' and '*')
                    next unless length($_) and /^(\d+)?(.*)/;
                    push @fg, [ $1, $2 ] unless $2 eq '*' or $2 eq 'all';
                }
            }
            # allow ValueConv to be specified by a '#' on the tag name
            if ($tag =~ s/#$//) {
                $$opts{SrcType} = 'ValueConv';
                $$opts{Type} = 'ValueConv' unless $dstTag;
            }
            # replace 'all' with '*' in tag and group names
            $tag = '*' if $tag eq 'all';
            # allow wildcards in tag names (handle differently from all tags: '*')
            if ($tag =~ /[?*]/ and $tag ne '*') {
                $$opts{WILD} = 1;   # set flag indicating wildcards were used in source tag
                $tag =~ s/\*/[-\\w]*/g;
                $tag =~ s/\?/[-\\w]/g;
            }
        }
        # redirect, exclude or set this tag (Note: @fg is empty if we don't care about the group)
        if ($dstTag) {
            # redirect this tag
            $isExclude and return { Error => "Can't redirect excluded tag" };
            # set destination group the same as source if necessary
          # (removed in 7.72 so '-xmp:*>*:*' will preserve XMP family 1 groups)
          # $dstGrp = $grp if $dstGrp eq '*' and $grp;
            # write to specified destination group/tag
            $dst = [ $dstGrp, $dstTag ];
        } elsif ($isExclude) {
            # implicitly assume '*' if first entry is an exclusion
            unshift @setList, [ [ ], '*', [ '', '*' ], $opts ] unless @setList;
            # exclude this tag by leaving $dst undefined
        } else {
            $dst = [ $grp || '', $$opts{WILD} ? '*' : $tag ]; # use same group name for dest
        }
        # save in reverse order so we don't set tags before an exclude
        unshift @setList, [ \@fg, $tag, $dst, $opts ];
    }
    # 2) initialize lists of matching tags for each setTag
    foreach $set (@setList) {
        $$set[2] and $setMatches{$set} = [ ];
    }
    # 3) loop through all tags in source image and save tags matching each setTag
    my %rtnInfo;
    foreach $tag (@tags) {
        # don't try to set errors or warnings
        if ($tag =~ /^(Error|Warning)( |$)/) {
            $rtnInfo{$tag} = $$info{$tag};
            next;
        }
        # only set specified tags
        my $lcTag = lc(GetTagName($tag));
        my (@grp, %grp);
SET:    foreach $set (@setList) {
            # check first for matching tag
            unless ($$set[1] eq $lcTag or $$set[1] eq '*') {
                # handle wildcards
                next unless $$set[3]{WILD} and $lcTag =~ /^$$set[1]$/;
            }
            # then check for matching group
            if (@{$$set[0]}) {
                # get lower case group names if not done already
                unless (@grp) {
                    @grp = map(lc, $srcExifTool->GetGroup($tag));
                    $grp{$_} = 1 foreach @grp;
                }
                foreach (@{$$set[0]}) {
                    my ($f, $g) = @$_;
                    if (defined $f) {
                        next SET unless defined $grp[$f] and $g eq $grp[$f];
                    } else {
                        next SET unless $grp{$g};
                    }
                }
            }
            last unless $$set[2];   # all done if we hit an exclude
            # add to the list of tags matching this setTag
            push @{$setMatches{$set}}, $tag;
        }
    }
    # 4) loop through each setTag in original order, setting new tag values
    foreach $set (reverse @setList) {
        # get options for SetNewValue
        my $opts = $$set[3];
        # handle expressions
        if ($$opts{EXPR}) {
            my $val = $srcExifTool->InsertTagValues(\@tags, $$set[1], 'Error');
            if ($$srcExifTool{VALUE}{Error}) {
                # pass on any error as a warning
                $tag = NextFreeTagKey(\%rtnInfo, 'Warning');
                $rtnInfo{$tag} = $$srcExifTool{VALUE}{Error};
                delete $$srcExifTool{VALUE}{Error};
                next unless defined $val;
            }
            my ($dstGrp, $dstTag) = @{$$set[2]};
            $$opts{Protected} = 1 unless $dstTag =~ /[?*]/ and $dstTag ne '*';
            $$opts{Group} = $dstGrp if $dstGrp;
            my @rtnVals = $self->SetNewValue($dstTag, $val, %$opts);
            $rtnInfo{$dstTag} = $val if $rtnVals[0]; # tag was set successfully
            next;
        }
        foreach $tag (@{$setMatches{$set}}) {
            my ($val, $noWarn);
            if ($$opts{SrcType} and $$opts{SrcType} ne $srcType) {
                $val = $srcExifTool->GetValue($tag, $$opts{SrcType});
            } else {
                $val = $$info{$tag};
            }
            my ($dstGrp, $dstTag) = @{$$set[2]};
            if ($dstGrp) {
                my @dstGrp = split /:/, $dstGrp;
                # destination group of '*' writes to same group as source tag
                # (family 1 unless otherwise specified)
                foreach (@dstGrp) {
                    next unless /^(\d*)(all|\*)$/i;
                    $_ = $1 . $srcExifTool->GetGroup($tag, length $1 ? $1 : 1);
                    $noWarn = 1;    # don't warn on wildcard destinations
                }
                $$opts{Group} = join ':', @dstGrp;
            } else {
                delete $$opts{Group};
            }
            # transfer maker note information if setting this tag
            if ($$srcExifTool{TAG_INFO}{$tag}{MakerNotes}) {
                $$self{MAKER_NOTE_FIXUP} = $$srcExifTool{MAKER_NOTE_FIXUP};
                $$self{MAKER_NOTE_BYTE_ORDER} = $$srcExifTool{MAKER_NOTE_BYTE_ORDER};
            }
            if ($dstTag eq '*') {
                $dstTag = $tag;
                $noWarn = 1;
            }
            if ($$set[1] eq '*' or $$set[3]{WILD}) {
                # don't copy from protected binary tags when using wildcards
                next if $$srcExifTool{TAG_INFO}{$tag}{Protected} and
                        $$srcExifTool{TAG_INFO}{$tag}{Binary};
                # don't copy to protected tags when using wildcards
                delete $$opts{Protected};
                # don't copy flattened tags if copying structures too when copying all
                $$opts{NoFlat} = $structOpt eq '2' ? 1 : 0;
            } else {
                # allow protected tags to be copied if specified explicitly
                $$opts{Protected} = 1 unless $dstTag =~ /[?*]/;
                delete $$opts{NoFlat};
            }
            # set value(s) for this tag
            my ($rtn, $wrn) = $self->SetNewValue($dstTag, $val, %$opts);
            # this was added in version 9.14, and allowed actions like "-subject<all" to
            # write values of multiple tags into a list, but it had the side effect of
            # duplicating items if there were multiple list tags with the same name
            # (eg. -use mwg "-creator<creator"), so disable this as of ExifTool 9.36:
            # $$opts{Replace} = 0;    # accumulate values from tags matching a single argument
            if ($wrn and not $noWarn) {
                # return this warning
                $rtnInfo{NextFreeTagKey(\%rtnInfo, 'Warning')} = $wrn;
                $noWarn = 1;
            }
            $rtnInfo{$tag} = $val if $rtn;  # tag was set successfully
        }
    }
    return \%rtnInfo;   # return information that we set
}

#------------------------------------------------------------------------------
# Get new value(s) for tag
# Inputs: 0) ExifTool object reference, 1) tag name or tagInfo hash ref
#         2) optional pointer to return new value hash reference (not part of public API)
#    or   0) ExifTool ref, 1) new value hash reference (not part of public API)
# Returns: List of new Raw values (list may be empty if tag is being deleted)
# Notes: 1) Preferentially returns new value from Extra table if writable Extra tag exists
# 2) Must call AFTER IsOverwriting() returns 1 to get proper value for shifted times
# 3) Tag name is case sensitive and may be prefixed by family 0 or 1 group name
# 4) Value may have been modified by CHECK_PROC routine after ValueConv
sub GetNewValue($$;$)
{
    local $_;
    my $self = shift;
    my $tag = shift;
    my $nvHash;
    if ((ref $tag eq 'HASH' and $$tag{IsNVH}) or not defined $tag) {
        $nvHash = $tag;
    } else {
        my $newValueHashPt = shift;
        if ($$self{NEW_VALUE}) {
            my ($group, $tagInfo);
            if (ref $tag) {
                $nvHash = $self->GetNewValueHash($tag);
            } elsif (defined($tagInfo = $Image::ExifTool::Extra{$tag}) and
                     $$tagInfo{Writable})
            {
                $nvHash = $self->GetNewValueHash($tagInfo);
            } else {
                # separate group from tag name
                $group = $1 if $tag =~ s/(.*)://;
                my @tagInfoList = FindTagInfo($tag);
                # decide which tag we want
GNV_TagInfo:    foreach $tagInfo (@tagInfoList) {
                    my $nvh = $self->GetNewValueHash($tagInfo) or next;
                    # select tag in specified group if necessary
                    while ($group and $group ne $$nvh{WriteGroup}) {
                        my @grps = $self->GetGroup($tagInfo);
                        if ($grps[0] eq $$nvh{WriteGroup}) {
                            # check family 1 group only if WriteGroup is not specific
                            last if $group eq $grps[1];
                        } else {
                            # otherwise check family 0 group
                            last if $group eq $grps[0];
                        }
                        # step to next entry in list
                        $nvh = $$nvh{Next} or next GNV_TagInfo;
                    }
                    $nvHash = $nvh;
                    # give priority to the one we are creating
                    last if defined $$nvHash{IsCreating};
                }
            }
        }
        # return new value hash if requested
        $newValueHashPt and $$newValueHashPt = $nvHash;
    }
    unless ($nvHash and $$nvHash{Value}) {
        return () if wantarray;  # return empty list
        return undef;
    }
    my $vals = $$nvHash{Value};
    # do inverse raw conversion if necessary
    # - must also check after doing a Shift
    if ($$nvHash{TagInfo}{RawConvInv} or $$nvHash{Shift}) {
        my @copyVals = @$vals;  # modify a copy of the values
        $vals = \@copyVals;
        my $tagInfo = $$nvHash{TagInfo};
        my $conv = $$tagInfo{RawConvInv};
        my $table = $$tagInfo{Table};
        my ($val, $checkProc);
        $checkProc = $$table{CHECK_PROC} if $$nvHash{Shift} and $table;
        local $SIG{'__WARN__'} = \&SetWarning;
        undef $evalWarning;
        foreach $val (@$vals) {
            # must check value now if it was shifted
            if ($checkProc) {
                my $err = &$checkProc($self, $tagInfo, \$val);
                if ($err or not defined $val) {
                    $err or $err = 'Error generating raw value';
                    $self->WarnOnce("$err for $$tagInfo{Name}");
                    @$vals = ();
                    last;
                }
                next unless $conv;
            } else {
                last unless $conv;
            }
            # do inverse raw conversion
            if (ref($conv) eq 'CODE') {
                $val = &$conv($val, $self);
            } else {
                #### eval RawConvInv ($self, $val, $taginfo)
                $val = eval $conv;
                $@ and $evalWarning = $@;
            }
            if ($evalWarning) {
                # an empty warning ("\n") ignores tag with no error
                if ($evalWarning ne "\n") {
                    my $err = CleanWarning() . " in $$tagInfo{Name} (RawConvInv)";
                    $self->WarnOnce($err);
                }
                @$vals = ();
                last;
            }
        }
    }
    # return our value(s)
    return @$vals if wantarray;
    return $$vals[0];
}

#------------------------------------------------------------------------------
# Return the total number of new values set
# Inputs: 0) ExifTool object reference
# Returns: Scalar context) Number of new values that have been set
#          List context) Number of new values, number of "pseudo" values
# ("pseudo" values are those which don't require rewriting the file to change)
sub CountNewValues($)
{
    my $self = shift;
    my $newVal = $$self{NEW_VALUE};
    my $num = 0;
    my $tag;
    if ($newVal) {
        $num += scalar keys %$newVal;
        # don't count "fake" tags (only in Extra table)
        foreach $tag (qw{Geotag Geosync}) {
            --$num if defined $$newVal{$Image::ExifTool::Extra{$tag}};
        }
    }
    $num += scalar keys %{$$self{DEL_GROUP}};
    return $num unless wantarray;
    my $pseudo = 0;
    if ($newVal) {
        # (Note: all writable "pseudo" tags must be found in Extra table)
        foreach $tag (qw{FileName Directory FileModifyDate FileCreateDate HardLink TestName}) {
            ++$pseudo if defined $$newVal{$Image::ExifTool::Extra{$tag}};
        }
    }
    return ($num, $pseudo);
}

#------------------------------------------------------------------------------
# Save new values for subsequent restore
# Inputs: 0) ExifTool object reference
# Returns: Number of times new values have been saved
# Notes: increments Save flag each time routine is called
sub SaveNewValues($)
{
    my $self = shift;
    my $newValues = $$self{NEW_VALUE};
    my $saveCount = ++$$self{SAVE_COUNT};
    my $key;
    foreach $key (keys %$newValues) {
        my $nvHash = $$newValues{$key};
        while ($nvHash) {
            # set Save count if not done already
            $$nvHash{Save} or $$nvHash{Save} = $saveCount;
            $nvHash = $$nvHash{Next};
        }
    }
    # initialize hash for saving overwritten new values
    $$self{SAVE_NEW_VALUE} = { };
    # make a copy of the delete group hash
    my %delGrp = %{$$self{DEL_GROUP}};
    $$self{SAVE_DEL_GROUP} = \%delGrp;
    return $saveCount;
}

#------------------------------------------------------------------------------
# Restore new values to last saved state
# Inputs: 0) ExifTool object reference
# Notes: Restores saved new values, but currently doesn't restore them in the
# original order, so there may be some minor side-effects when restoring tags
# with overlapping groups. eg) XMP:Identifier, XMP-dc:Identifier
sub RestoreNewValues($)
{
    my $self = shift;
    my $newValues = $$self{NEW_VALUE};
    my $savedValues = $$self{SAVE_NEW_VALUE};
    my $key;
    # 1) remove any new values which don't have the Save flag set
    if ($newValues) {
        my @keys = keys %$newValues;
        foreach $key (@keys) {
            my $lastHash;
            my $nvHash = $$newValues{$key};
            while ($nvHash) {
                if ($$nvHash{Save}) {
                    $lastHash = $nvHash;
                } else {
                    # remove this entry from the list
                    if ($lastHash) {
                        $$lastHash{Next} = $$nvHash{Next};
                    } elsif ($$nvHash{Next}) {
                        $$newValues{$key} = $$nvHash{Next};
                    } else {
                        delete $$newValues{$key};
                    }
                }
                $nvHash = $$nvHash{Next};
            }
        }
    }
    # 2) restore saved new values
    if ($savedValues) {
        $newValues or $newValues = $$self{NEW_VALUE} = { };
        foreach $key (keys %$savedValues) {
            if ($$newValues{$key}) {
                # add saved values to end of list
                my $nvHash = LastInList($$newValues{$key});
                $$nvHash{Next} = $$savedValues{$key};
            } else {
                $$newValues{$key} = $$savedValues{$key};
            }
        }
        $$self{SAVE_NEW_VALUE} = { };  # reset saved new values
    }
    # 3) restore delete groups
    my %delGrp = %{$$self{SAVE_DEL_GROUP}};
    $$self{DEL_GROUP} = \%delGrp;
}

#------------------------------------------------------------------------------
# Set filesystem time from from FileModifyDate or FileCreateDate tag
# Inputs: 0) ExifTool object reference, 1) file name or file ref
#         2) time (-M or -C) of original file (used for shift; obtained from file if not given)
#         3) tag name to write (undef for 'FileModifyDate')
#         4) flag set if argument 2 has already been converted to Unix seconds
# Returns: 1=time changed OK, 0=nothing done, -1=error setting time
#          (increments CHANGED flag and sets corresponding WRITTEN tag)
sub SetFileModifyDate($$;$$$)
{
    my ($self, $file, $originalTime, $tag, $isUnixTime) = @_;
    my $nvHash;
    $tag = 'FileModifyDate' unless defined $tag;
    my $val = $self->GetNewValue($tag, \$nvHash);
    return 0 unless defined $val;
    my $isOverwriting = $self->IsOverwriting($nvHash);
    return 0 unless $isOverwriting;
    # can currently only set creation date on Windows systems
    return 0 if $tag eq 'FileCreateDate' and $^O ne 'MSWin32';
    if ($isOverwriting < 0) {  # are we shifting time?
        # use original time of this file if not specified
        unless (defined $originalTime) {
            my ($aTime, $mTime, $cTime) = $self->GetFileTime($file);
            $originalTime = ($tag eq 'FileCreateDate') ? $cTime : $mTime;
            return 0 unless defined $originalTime;
            $isUnixTime = 1;
        }
        $originalTime = int($^T - $originalTime*(24*3600) + 0.5) unless $isUnixTime;
        return 0 unless $self->IsOverwriting($nvHash, $originalTime);
        $val = $$nvHash{Value}[0]; # get shifted value
    }
    my ($aTime, $mTime, $cTime);
    if ($tag eq 'FileCreateDate') {
        eval { require Win32::API } or $self->WarnOnce("Install Win32::API to set $tag"), return -1;
        eval { require Win32API::File } or $self->WarnOnce("Install Win32API::File to set $tag"), return -1;
        $cTime = $val;
    } else {
        $aTime = $mTime = $val;
    }
    $self->SetFileTime($file, $aTime, $mTime, $cTime) or $self->Warn("Error setting $tag"), return -1;
    ++$$self{CHANGED};
    $$self{WRITTEN}{$tag} = $val;   # remember that we wrote this tag
    $self->VerboseValue("+ $tag", $val);
    return 1;
}

#------------------------------------------------------------------------------
# Change file name and/or directory from FileName and Directory tags
# Inputs: 0) ExifTool object reference, 1) current file name (including path)
#         2) new name (or undef to build from FileName and Directory tags)
#         3) option: 'Link' to create link instead of renaming file
#                    'Test' to only print new file name
# Returns: 1=name changed OK, 0=nothing changed, -1=error changing name
#          (and increments CHANGED flag if filename changed)
# Notes: Will not overwrite existing file.  Creates directories as necessary.
sub SetFileName($$;$$)
{
    my ($self, $file, $newName, $opt) = @_;
    my ($nvHash, $doName, $doDir);
    $opt or $opt = '';
    # determine the new file name
    unless (defined $newName) {
        if ($opt) {
            if ($opt eq 'Link') {
                $newName = $self->GetNewValue('HardLink');
            } elsif ($opt eq 'Test') {
                $newName = $self->GetNewValue('TestName');
            }
            return 0 unless defined $newName;
        } else {
            my $filename = $self->GetNewValue('FileName', \$nvHash);
            $doName = 1 if defined $filename and $self->IsOverwriting($nvHash, $file);
            my $dir = $self->GetNewValue('Directory', \$nvHash);
            $doDir = 1 if defined $dir and $self->IsOverwriting($nvHash, $file);
            return 0 unless $doName or $doDir;  # nothing to do
            if ($doName) {
                $newName = GetNewFileName($file, $filename);
                $newName = GetNewFileName($newName, $dir) if $doDir;
            } else {
                $newName = GetNewFileName($file, $dir);
            }
        }
    }
    $newName =~ tr/\0//d;   # make sure name doesn't contain nulls
    # protect against empty file name
    length $newName or $self->Warn('New file name is empty'), return -1;
    # don't replace existing file
    if ($self->Exists($newName)) {
        if ($file ne $newName or $opt eq 'Link') {
            $self->Warn("File '$newName' already exists");
            return -1;
        } else {
            $self->Warn('File name is unchanged');
            return 0;
        }
    }
    if ($opt eq 'Test') {
        my $out = $$self{OPTIONS}{TextOut};
        print $out "'$file' --> '$newName'\n";
        return 1;
    }
    # create directory for new file if necessary
    my $result;
    if (($result = $self->CreateDirectory($newName)) != 0) {
        if ($result < 0) {
            $self->Warn("Error creating directory for '$newName'");
            return -1;
        }
        $self->VPrint(0, "Created directory for '$newName'");
    }
    if ($opt eq 'Link') {
        unless (link $file, $newName) {
            $self->Warn("Error creating link '$newName'");
            return -1;
        }
        ++$$self{CHANGED};
        $self->VerboseValue('+ HardLink', $newName);
        return 1;
    }
    # attempt to rename the file
    unless ($self->Rename($file, $newName)) {
        local (*EXIFTOOL_SFN_IN, *EXIFTOOL_SFN_OUT);
        # renaming didn't work, so copy the file instead
        unless ($self->Open(\*EXIFTOOL_SFN_IN, $file)) {
            $self->Warn("Error opening '$file'");
            return -1;
        }
        unless ($self->Open(\*EXIFTOOL_SFN_OUT, $newName, '>')) {
            close EXIFTOOL_SFN_IN;
            $self->Warn("Error creating '$newName'");
            return -1;
        }
        binmode EXIFTOOL_SFN_IN;
        binmode EXIFTOOL_SFN_OUT;
        my ($buff, $err);
        while (read EXIFTOOL_SFN_IN, $buff, 65536) {
            print EXIFTOOL_SFN_OUT $buff or $err = 1;
        }
        close EXIFTOOL_SFN_OUT or $err = 1;
        close EXIFTOOL_SFN_IN;
        if ($err) {
            $self->Unlink($newName);    # erase bad output file
            $self->Warn("Error writing '$newName'");
            return -1;
        }
        # preserve modification time
        my ($aTime, $mTime, $cTime) = $self->GetFileTime($file);
        $self->SetFileTime($newName, $aTime, $mTime, $cTime);
        # remove the original file
        $self->Unlink($file) or $self->Warn('Error removing old file');
    }
    $$self{NewName} = $newName; # remember new file name
    ++$$self{CHANGED};
    $self->VerboseValue('+ FileName', $newName);
    return 1;
}

#------------------------------------------------------------------------------
# Write information back to file
# Inputs: 0) ExifTool object reference,
#         1) input filename, file ref, RAF ref, or scalar ref (or '' or undef to create from scratch)
#         2) output filename, file ref, or scalar ref (or undef to overwrite)
#         3) optional output file type (required only if input file is not specified
#            and output file is a reference)
# Returns: 1=file written OK, 2=file written but no changes made, 0=file write error
sub WriteInfo($$;$$)
{
    local ($_, *EXIFTOOL_FILE2, *EXIFTOOL_OUTFILE);
    my ($self, $infile, $outfile, $outType) = @_;
    my (@fileTypeList, $fileType, $tiffType, $hdr, $seekErr, $type, $tmpfile, $hardLink, $testName);
    my ($inRef, $outRef, $closeIn, $closeOut, $outPos, $outBuff, $eraseIn, $raf);
    my $oldRaf = $$self{RAF};
    my $rtnVal = 0;

    # initialize member variables
    $self->Init();

    # first, save original file modify date if necessary
    # (do this now in case we are modifying file in place and shifting date)
    my ($nvHash, $nvHash2, $originalTime, $createTime);
    my $fileModifyDate = $self->GetNewValue('FileModifyDate', \$nvHash);
    my $fileCreateDate = $self->GetNewValue('FileCreateDate', \$nvHash2);
    my ($aTime, $mTime, $cTime);
    if (defined $fileModifyDate and $self->IsOverwriting($nvHash) < 0 and
        defined $infile and ref $infile ne 'SCALAR')
    {
        ($aTime, $mTime, $cTime) = $self->GetFileTime($infile);
        $originalTime = $mTime;
    }
    if (defined $fileCreateDate and $self->IsOverwriting($nvHash2) < 0 and
        defined $infile and ref $infile ne 'SCALAR')
    {
        ($aTime, $mTime, $cTime) = $self->GetFileTime($infile) unless defined $cTime;
        $createTime = $cTime;
    }
#
# do quick in-place change of file dir/name or date if that is all we are doing
#
    my ($numNew, $numPseudo) = $self->CountNewValues();
    if (not defined $outfile and defined $infile) {
        $hardLink = $self->GetNewValue('HardLink');
        $testName = $self->GetNewValue('TestName');
        undef $hardLink if defined $hardLink and not length $hardLink;
        undef $testName if defined $testName and not length $testName;
        my $newFileName =  $self->GetNewValue('FileName', \$nvHash);
        my $newDir = $self->GetNewValue('Directory');
        if (defined $newDir and length $newDir) {
            $newDir .= '/' unless $newDir =~ m{/$};
        } else {
            undef $newDir;
        }
        if ($numNew == $numPseudo) {
            $rtnVal = 2;
            if (defined $fileModifyDate and (not ref $infile or UNIVERSAL::isa($infile,'GLOB'))) {
                $self->SetFileModifyDate($infile) > 0 and $rtnVal = 1;
            }
            if (defined $fileCreateDate and (not ref $infile or UNIVERSAL::isa($infile,'GLOB'))) {
                $self->SetFileModifyDate($infile, undef, 'FileCreateDate') > 0 and $rtnVal = 1;
            }
            if ((defined $newFileName or defined $newDir) and not ref $infile) {
                $self->SetFileName($infile) > 0 and $rtnVal = 1;
            }
            if (defined $hardLink or defined $testName) {
                my $src = $$self{NewName};
                $src = $infile unless defined $src;
                $hardLink and $self->SetFileName($src, $hardLink, 'Link') and $rtnVal = 1;
                $testName and $self->SetFileName($src, $testName, 'Test') and $rtnVal = 1;
            }
            return $rtnVal;
        } elsif (defined $newFileName and length $newFileName) {
            # can't simply rename file, so just set the output name if new FileName
            # --> in this case, must erase original copy
            if (ref $infile) {
                $outfile = $newFileName;
                # can't delete original
            } elsif ($self->IsOverwriting($nvHash, $infile)) {
                $outfile = GetNewFileName($infile, $newFileName);
                $eraseIn = 1; # delete original
            }
        }
        # set new directory if specified
        if (defined $newDir) {
            $outfile = $infile unless defined $outfile or ref $infile;
            if (defined $outfile) {
                $outfile = GetNewFileName($outfile, $newDir);
                $eraseIn = 1 unless ref $infile;
            }
        }
    }
#
# set up input file
#
    if (ref $infile) {
        $inRef = $infile;
        if (UNIVERSAL::isa($inRef,'GLOB')) {
            seek($inRef, 0, 0); # make sure we are at the start of the file
        } elsif (UNIVERSAL::isa($inRef,'File::RandomAccess')) {
            $inRef->Seek(0);
            $raf = $inRef;
        } elsif ($] >= 5.006 and (eval { require Encode; Encode::is_utf8($$inRef) } or $@)) {
            # convert image data from UTF-8 to character stream if necessary
            my $buff = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$$inRef)) : Encode::encode('utf8',$$inRef);
            if (defined $outfile) {
                $inRef = \$buff;
            } else {
                $$inRef = $buff;
            }
        }
    } elsif (defined $infile and $infile ne '') {
        # write to a temporary file if no output file given
        $outfile = $tmpfile = "${infile}_exiftool_tmp" unless defined $outfile;
        if ($self->Open(\*EXIFTOOL_FILE2, $infile)) {
            $fileType = GetFileType($infile);
            @fileTypeList = GetFileType($infile);
            $tiffType = $$self{FILE_EXT} = GetFileExtension($infile);
            $self->VPrint(0, "Rewriting $infile...\n");
            $inRef = \*EXIFTOOL_FILE2;
            $closeIn = 1;   # we must close the file since we opened it
        } else {
            $self->Error('Error opening file');
            return 0;
        }
    } elsif (not defined $outfile) {
        $self->Error("WriteInfo(): Must specify infile or outfile\n");
        return 0;
    } else {
        # create file from scratch
        $outType = GetFileExtension($outfile) unless $outType or ref $outfile;
        if (CanCreate($outType)) {
            $fileType = $tiffType = $outType;   # use output file type if no input file
            $infile = "$fileType file";         # make bogus file name
            $self->VPrint(0, "Creating $infile...\n");
            $inRef = \ '';      # set $inRef to reference to empty data
        } elsif ($outType) {
            $self->Error("Can't create $outType files");
            return 0;
        } else {
            $self->Error("Can't create file (unknown type)");
            return 0;
        }
    }
    unless (@fileTypeList) {
        if ($fileType) {
            @fileTypeList = ( $fileType );
        } else {
            @fileTypeList = @fileTypes;
            $tiffType = 'TIFF';
        }
    }
#
# set up output file
#
    if (ref $outfile) {
        $outRef = $outfile;
        if (UNIVERSAL::isa($outRef,'GLOB')) {
            binmode($outRef);
            $outPos = tell($outRef);
        } else {
            # initialize our output buffer if necessary
            defined $$outRef or $$outRef = '';
            $outPos = length($$outRef);
        }
    } elsif (not defined $outfile) {
        # editing in place, so write to memory first
        # (only when infile is a file ref or scalar ref)
        if ($raf) {
            $self->Error("Can't edit File::RandomAccess object in place");
            return 0;
        }
        $outBuff = '';
        $outRef = \$outBuff;
        $outPos = 0;
    } elsif ($self->Exists($outfile)) {
        $self->Error("File already exists: $outfile");
    } elsif ($self->Open(\*EXIFTOOL_OUTFILE, $outfile, '>')) {
        $outRef = \*EXIFTOOL_OUTFILE;
        $closeOut = 1;  # we must close $outRef
        binmode($outRef);
        $outPos = 0;
    } else {
        my $tmp = $tmpfile ? ' temporary' : '';
        $self->Error("Error creating$tmp file: $outfile");
    }
#
# write the file
#
    until ($$self{VALUE}{Error}) {
        # create random access file object (disable seek test in case of straight copy)
        $raf or $raf = new File::RandomAccess($inRef, 1);
        $raf->BinMode();
        if ($numNew == $numPseudo) {
            $rtnVal = 1;
            # just do a straight copy of the file (no "real" tags are being changed)
            my $buff;
            while ($raf->Read($buff, 65536)) {
                Write($outRef, $buff) or $rtnVal = -1, last;
            }
            last;
        } elsif (not ref $infile and ($infile eq '-' or $infile =~ /\|$/)) {
            # patch for Windows command shell pipe
            $$raf{TESTED} = -1; # force buffering
        } else {
            $raf->SeekTest();
        }
       # $raf->Debug() and warn "  RAF debugging enabled!\n";
        my $inPos = $raf->Tell();
        $$self{RAF} = $raf;
        my %dirInfo = (
            RAF => $raf,
            OutFile => $outRef,
        );
        $raf->Read($hdr, 1024) or $hdr = '';
        $raf->Seek($inPos, 0) or $seekErr = 1;
        my $wrongType;
        until ($seekErr) {
            $type = shift @fileTypeList;
            # do quick test to see if this is the right file type
            if ($magicNumber{$type} and length($hdr) and $hdr !~ /^$magicNumber{$type}/s) {
                next if @fileTypeList;
                $wrongType = 1;
                last;
            }
            # save file type in member variable
            $dirInfo{Parent} = $$self{FILE_TYPE} = $$self{PATH}[0] = $type;
            # determine which directories we must write for this file type
            $self->InitWriteDirs($type);
            if ($type eq 'JPEG' or $type eq 'EXV') {
                $rtnVal = $self->WriteJPEG(\%dirInfo);
            } elsif ($type eq 'TIFF') {
                # disallow writing of some TIFF-based RAW images:
                if (grep /^$tiffType$/, @{$noWriteFile{TIFF}}) {
                    $fileType = $tiffType;
                    undef $rtnVal;
                } else {
                    $dirInfo{Parent} = $tiffType;
                    $rtnVal = $self->ProcessTIFF(\%dirInfo);
                }
            } elsif ($type eq 'GIF') {
                require Image::ExifTool::GIF;
                $rtnVal = Image::ExifTool::GIF::ProcessGIF($self,\%dirInfo);
            } elsif ($type eq 'CRW') {
                require Image::ExifTool::CanonRaw;
                $rtnVal = Image::ExifTool::CanonRaw::WriteCRW($self, \%dirInfo);
            } elsif ($type eq 'MRW') {
                require Image::ExifTool::MinoltaRaw;
                $rtnVal = Image::ExifTool::MinoltaRaw::ProcessMRW($self, \%dirInfo);
            } elsif ($type eq 'RAF') {
                require Image::ExifTool::FujiFilm;
                $rtnVal = Image::ExifTool::FujiFilm::WriteRAF($self, \%dirInfo);
            } elsif ($type eq 'ORF' or $type eq 'RAW') {
                $rtnVal = $self->ProcessTIFF(\%dirInfo);
            } elsif ($type eq 'X3F') {
                require Image::ExifTool::SigmaRaw;
                $rtnVal = Image::ExifTool::SigmaRaw::ProcessX3F($self, \%dirInfo);
            } elsif ($type eq 'PNG') {
                require Image::ExifTool::PNG;
                $rtnVal = Image::ExifTool::PNG::ProcessPNG($self, \%dirInfo);
            } elsif ($type eq 'MIE') {
                require Image::ExifTool::MIE;
                $rtnVal = Image::ExifTool::MIE::ProcessMIE($self, \%dirInfo);
            } elsif ($type eq 'XMP') {
                require Image::ExifTool::XMP;
                $rtnVal = Image::ExifTool::XMP::WriteXMP($self, \%dirInfo);
            } elsif ($type eq 'PPM') {
                require Image::ExifTool::PPM;
                $rtnVal = Image::ExifTool::PPM::ProcessPPM($self, \%dirInfo);
            } elsif ($type eq 'PSD') {
                require Image::ExifTool::Photoshop;
                $rtnVal = Image::ExifTool::Photoshop::ProcessPSD($self, \%dirInfo);
            } elsif ($type eq 'EPS' or $type eq 'PS') {
                require Image::ExifTool::PostScript;
                $rtnVal = Image::ExifTool::PostScript::WritePS($self, \%dirInfo);
            } elsif ($type eq 'PDF') {
                require Image::ExifTool::PDF;
                $rtnVal = Image::ExifTool::PDF::WritePDF($self, \%dirInfo);
            } elsif ($type eq 'ICC') {
                require Image::ExifTool::ICC_Profile;
                $rtnVal = Image::ExifTool::ICC_Profile::WriteICC($self, \%dirInfo);
            } elsif ($type eq 'VRD') {
                require Image::ExifTool::CanonVRD;
                $rtnVal = Image::ExifTool::CanonVRD::ProcessVRD($self, \%dirInfo);
            } elsif ($type eq 'DR4') {
                require Image::ExifTool::CanonVRD;
                $rtnVal = Image::ExifTool::CanonVRD::ProcessDR4($self, \%dirInfo);
            } elsif ($type eq 'JP2') {
                require Image::ExifTool::Jpeg2000;
                $rtnVal = Image::ExifTool::Jpeg2000::ProcessJP2($self, \%dirInfo);
            } elsif ($type eq 'IND') {
                require Image::ExifTool::InDesign;
                $rtnVal = Image::ExifTool::InDesign::ProcessIND($self, \%dirInfo);
            } elsif ($type eq 'MOV') {
                require Image::ExifTool::QuickTime;
                $rtnVal = Image::ExifTool::QuickTime::WriteMOV($self, \%dirInfo);
            } elsif ($type eq 'EXIF') {
                # go through WriteDirectory so block writes, etc are handled
                my $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main');
                my $buff = $self->WriteDirectory(\%dirInfo, $tagTablePtr, \&WriteTIFF);
                if (defined $buff) {
                    $rtnVal = Write($outRef, $buff) ? 1 : -1;
                } else {
                    $rtnVal = 0;
                }
            } else {
                undef $rtnVal;  # flag that we don't write this type of file
            }
            # all done unless we got the wrong type
            last if $rtnVal;
            last unless @fileTypeList;
            # seek back to original position in files for next try
            $raf->Seek($inPos, 0) or $seekErr = 1, last;
            if (UNIVERSAL::isa($outRef,'GLOB')) {
                seek($outRef, 0, $outPos);
            } else {
                $$outRef = substr($$outRef, 0, $outPos);
            }
        }
        # print file format errors
        unless ($rtnVal) {
            my $err;
            if ($seekErr) {
                $err = 'Error seeking in file';
            } elsif ($fileType and defined $rtnVal) {
                if ($$self{VALUE}{Error}) {
                    # existing error message will do
                } elsif ($fileType eq 'RAW') {
                    $err = 'Writing this type of RAW file is not supported';
                } else {
                    if ($wrongType) {
                        $err = "Not a valid $fileType";
                        # do a quick check to see what this file looks like
                        foreach $type (@fileTypes) {
                            next unless $magicNumber{$type};
                            next unless $hdr =~ /^$magicNumber{$type}/s;
                            $err .= " (looks more like a $type)";
                            last;
                        }
                    } else {
                        $err = 'Format error in file';
                    }
                }
            } elsif ($fileType) {
                # get specific type of file from extension
                $fileType = GetFileExtension($infile) if $infile and GetFileType($infile);
                $err = "Writing of $fileType files is not yet supported";
            } else {
                $err = 'Writing of this type of file is not supported';
            }
            $self->Error($err) if $err;
            $rtnVal = 0;    # (in case it was undef)
        }
       # $raf->Close();  # only used to force debug output
        last;   # (didn't really want to loop)
    }
    # don't return success code if any error occurred
    if ($rtnVal > 0) {
        unless (Tell($outRef) or $$self{VALUE}{Error}) {
            # don't write a file with zero length
            if (defined $hdr and length $hdr) {
                $self->Error("Can't delete all meta information from $type file");
            } else {
                $self->Error('Nothing to write');
            }
        }
        $rtnVal = 0 if $$self{VALUE}{Error};
    }

    # rewrite original file in place if required
    if (defined $outBuff) {
        if ($rtnVal <= 0 or not $$self{CHANGED}) {
            # nothing changed, so no need to write $outBuff
        } elsif (UNIVERSAL::isa($inRef,'GLOB')) {
            my $len = length($outBuff);
            my $size;
            $rtnVal = -1 unless
                seek($inRef, 0, 2) and          # seek to the end of file
                ($size = tell $inRef) >= 0 and  # get the file size
                seek($inRef, 0, 0) and          # seek back to the start
                print $inRef $outBuff and       # write the new data
                ($len >= $size or               # if necessary:
                eval { truncate($inRef, $len) }); #  shorten output file
        } else {
            $$inRef = $outBuff;                 # replace original data
        }
        $outBuff = '';  # free memory but leave $outBuff defined
    }
    # close input file if we opened it
    if ($closeIn) {
        # errors on input file are significant if we edited the file in place
        $rtnVal and $rtnVal = -1 unless close($inRef) or not defined $outBuff;
        if ($rtnVal > 0) {
            # copy Mac OS resource fork if it exists
            if ($^O eq 'darwin' and -s "$infile/..namedfork/rsrc") {
                if ($$self{DEL_GROUP}{RSRC}) {
                    $self->VPrint(0,"Deleting Mac OS resource fork\n");
                    ++$$self{CHANGED};
                } else {
                    $self->VPrint(0,"Copying Mac OS resource fork\n");
                    my ($buf, $err);
                    local (*SRC, *DST);
                    if ($self->Open(\*SRC, "$infile/..namedfork/rsrc")) {
                        if ($self->Open(\*DST, "$outfile/..namedfork/rsrc", '>')) {
                            binmode SRC; # (not necessary for Darwin, but let's be thorough)
                            binmode DST;
                            while (read SRC, $buf, 65536) {
                                print DST $buf or $err = 'copying', last;
                            }
                            close DST or $err or $err = 'closing';
                        } else {
                            # (this is normal if the destination filesystem isn't Mac OS)
                            $self->Warn('Error creating Mac OS resource fork');
                        }
                        close SRC;
                    } else {
                        $err = 'opening';
                    }
                    $rtnVal = 0 if $err and $self->Error("Error $err Mac OS resource fork", 2);
                }
            }
            # erase input file if renaming while editing information in place
            $self->Unlink($infile) or $self->Warn('Error erasing original file') if $eraseIn;
        }
    }
    # close output file if we created it
    if ($closeOut) {
        # close file and set $rtnVal to -1 if there was an error
        $rtnVal and $rtnVal = -1 unless close($outRef);
        # erase the output file if we weren't successful
        if ($rtnVal <= 0) {
            $self->Unlink($outfile);
        # else rename temporary file if necessary
        } elsif ($tmpfile) {
            CopyFileAttrs($infile, $tmpfile);   # copy attributes to new file
            unless ($self->Rename($tmpfile, $infile)) {
                # some filesystems won't overwrite with 'rename', so try erasing original
                if (not $self->Unlink($infile)) {
                    $self->Unlink($tmpfile);
                    $self->Error('Error renaming temporary file');
                    $rtnVal = 0;
                } elsif (not $self->Rename($tmpfile, $infile)) {
                    $self->Error('Error renaming temporary file after deleting original');
                    $rtnVal = 0;
                }
            }
        }
    }
    # set FileModifyDate if requested (and if possible!)
    if ($rtnVal > 0 and ($closeOut or ($closeIn and defined $outBuff))) {
        my $target = $closeOut ? $outfile : $infile;
        if (defined $fileModifyDate and
            $self->SetFileModifyDate($target, $originalTime, undef, 1) > 0)
        {
            ++$$self{CHANGED}; # we changed something
        }
        # set FileCreateDate if requested (and if possible!)
        if (defined $fileCreateDate and
            $self->SetFileModifyDate($target, $createTime, 'FileCreateDate', 1))
        {
            ++$$self{CHANGED}; # we changed something
        }
        # create hard link if requested and no output filename specified (and if possible!)
        if (defined $hardLink and $self->SetFileName($target, $hardLink, 'Link')) {
            ++$$self{CHANGED}; # we changed something (sort of)
        }
        defined $testName and $self->SetFileName($target, $testName, 'Test');
    }
    # check for write error and set appropriate error message and return value
    if ($rtnVal < 0) {
        $self->Error('Error writing output file') unless $$self{VALUE}{Error};
        $rtnVal = 0;    # return 0 on failure
    } elsif ($rtnVal > 0) {
        ++$rtnVal unless $$self{CHANGED};
    }
    # set things back to the way they were
    $$self{RAF} = $oldRaf;

    return $rtnVal;
}

#------------------------------------------------------------------------------
# Get list of all available tags for specified group
# Inputs: 0) optional group name (or string of names separated by colons)
# Returns: tag list (sorted alphabetically)
# Notes: Can't get tags for specific IFD
sub GetAllTags(;$)
{
    local $_;
    my $group = shift;
    my (%allTags, @groups);
    @groups = split ':', $group if $group;

    my $et = new Image::ExifTool;
    LoadAllTables();    # first load all our tables
    my @tableNames = keys %allTables;

    # loop through all tables and save tag names to %allTags hash
    while (@tableNames) {
        my $table = GetTagTable(pop @tableNames);
        # generate flattened tag names for structure fields if this is an XMP table
        if ($$table{GROUPS} and $$table{GROUPS}{0} eq 'XMP') {
            Image::ExifTool::XMP::AddFlattenedTags($table);
        }
        my $tagID;
        foreach $tagID (TagTableKeys($table)) {
            my @infoArray = GetTagInfoList($table,$tagID);
            my $tagInfo;
GATInfo:    foreach $tagInfo (@infoArray) {
                my $tag = $$tagInfo{Name};
                $tag or warn("no name for tag!\n"), next;
                # don't list subdirectories unless they are writable
                next if $$tagInfo{SubDirectory} and not $$tagInfo{Writable};
                next if $$tagInfo{Hidden};  # ignore hidden tags
                if (@groups) {
                    my @tg = $et->GetGroup($tagInfo);
                    foreach $group (@groups) {
                        next GATInfo unless grep /^$group$/i, @tg;
                    }
                }
                $allTags{$tag} = 1;
            }
        }
    }
    return sort keys %allTags;
}

#------------------------------------------------------------------------------
# Get list of all writable tags
# Inputs: 0) optional group name (or names separated by colons)
# Returns: tag list (sorted alphabetically)
sub GetWritableTags(;$)
{
    local $_;
    my $group = shift;
    my (%writableTags, @groups);
    @groups = split ':', $group if $group;

    my $et = new Image::ExifTool;
    LoadAllTables();
    my @tableNames = keys %allTables;

    while (@tableNames) {
        my $tableName = pop @tableNames;
        my $table = GetTagTable($tableName);
        # generate flattened tag names for structure fields if this is an XMP table
        if ($$table{GROUPS} and $$table{GROUPS}{0} eq 'XMP') {
            Image::ExifTool::XMP::AddFlattenedTags($table);
        }
        # attempt to load Write tables if autoloaded
        my @parts = split(/::/,$tableName);
        if (@parts > 3) {
            my $i = $#parts - 1;
            $parts[$i] = "Write$parts[$i]";   # add 'Write' before class name
            my $module = join('::',@parts[0..$i]);
            eval { require $module }; # (fails silently if nothing loaded)
        }
        my $tagID;
        foreach $tagID (TagTableKeys($table)) {
            my @infoArray = GetTagInfoList($table,$tagID);
            my $tagInfo;
GWTInfo:    foreach $tagInfo (@infoArray) {
                my $tag = $$tagInfo{Name};
                $tag or warn("no name for tag!\n"), next;
                my $writable = $$tagInfo{Writable};
                next unless $writable or ($$table{WRITABLE} and
                    not defined $writable and not $$tagInfo{SubDirectory});
                next if $$tagInfo{Hidden};  # ignore hidden tags
                if (@groups) {
                    my @tg = $et->GetGroup($tagInfo);
                    foreach $group (@groups) {
                        next GWTInfo unless grep /^$group$/i, @tg;
                    }
                }
                $writableTags{$tag} = 1;
            }
        }
    }
    return sort keys %writableTags;
}

#------------------------------------------------------------------------------
# Get list of all group names
# Inputs: 0) Group family number
# Returns: List of group names (sorted alphabetically)
sub GetAllGroups($)
{
    local $_;
    my $family = shift || 0;

    $family == 3 and return('Doc#', 'Main');
    $family == 4 and return('Copy#');

    LoadAllTables();    # first load all our tables

    my @tableNames = keys %allTables;

    # loop through all tag tables and get all group names
    my %allGroups;
    while (@tableNames) {
        my $table = GetTagTable(pop @tableNames);
        my ($grps, $grp, $tag, $tagInfo);
        $allGroups{$grp} = 1 if ($grps = $$table{GROUPS}) and ($grp = $$grps{$family});
        foreach $tag (TagTableKeys($table)) {
            my @infoArray = GetTagInfoList($table, $tag);
            foreach $tagInfo (@infoArray) {
                next unless ($grps = $$tagInfo{Groups}) and ($grp = $$grps{$family});
                $allGroups{$grp} = 1;
            }
        }
    }
    return sort keys %allGroups;
}

#------------------------------------------------------------------------------
# get priority group list for new values
# Inputs: 0) ExifTool object reference
# Returns: List of group names
sub GetNewGroups($)
{
    my $self = shift;
    return @{$$self{WRITE_GROUPS}};
}

#------------------------------------------------------------------------------
# Get list of all deletable group names
# Returns: List of group names (sorted alphabetically)
sub GetDeleteGroups()
{
    return sort @delGroups, @delGroup2;
}

#------------------------------------------------------------------------------
# Add user-defined tags at run time
# Inputs: 0) destination table name, 1) tagID/tagInfo pairs for tags to add
# Returns: number of tags added
# Notes: will replace existing tags
sub AddUserDefinedTags($%)
{
    local $_;
    my ($tableName, %addTags) = @_;
    my $table = GetTagTable($tableName) or return 0;
    # add tags to writer lookup
    Image::ExifTool::TagLookup::AddTags(\%addTags, $tableName);
    my $tagID;
    my $num = 0;
    foreach $tagID (keys %addTags) {
        next if $specialTags{$tagID};
        delete $$table{$tagID}; # delete old entry if it existed
        AddTagToTable($table, $tagID, $addTags{$tagID}, 1);
        ++$num;
    }
    return $num;
}

#==============================================================================
# Functions below this are not part of the public API

#------------------------------------------------------------------------------
# Maintain backward compatibility for old GetNewValues function name
sub GetNewValues($$;$)
{
    my ($self, $tag, $nvHashPt) = @_;
    return $self->GetNewValue($tag, $nvHashPt);
}

#------------------------------------------------------------------------------
# Un-escape string according to options settings and clear UTF-8 flag
# Inputs: 0) ExifTool ref, 1) string ref or string ref ref
# Notes: also de-references SCALAR values
sub Sanitize($$)
{
    my ($self, $valPt) = @_;
    # de-reference SCALAR references
    $$valPt = $$$valPt if ref $$valPt eq 'SCALAR';
    # make sure the Perl UTF-8 flag is OFF for the value if perl 5.6 or greater
    # (otherwise our byte manipulations get corrupted!!)
    if ($] >= 5.006 and (eval { require Encode; Encode::is_utf8($$valPt) } or $@)) {
        # repack by hand if Encode isn't available
        $$valPt = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$$valPt)) : Encode::encode('utf8',$$valPt);
    }
    # un-escape value if necessary
    if ($$self{OPTIONS}{Escape}) {
        # (XMP.pm and HTML.pm were require'd as necessary when option was set)
        if ($$self{OPTIONS}{Escape} eq 'XML') {
            $$valPt = Image::ExifTool::XMP::UnescapeXML($$valPt);
        } elsif ($$self{OPTIONS}{Escape} eq 'HTML') {
            $$valPt = Image::ExifTool::HTML::UnescapeHTML($$valPt);
        }
    }
}

#------------------------------------------------------------------------------
# Apply inverse conversions
# Inputs: 0) ExifTool ref, 1) value, 2) tagInfo (or Struct item) ref,
#         3) tag name, 4) group 1 name, 5) conversion type (or undef),
#         6) [optional] want group ("" for structure field)
# Returns: 0) converted value, 1) error string (or undef on success)
# Notes:
# - uses ExifTool "ConvType" member when conversion type is undef
# - conversion types other than 'ValueConv' and 'PrintConv' are treated as 'Raw'
sub ConvInv($$$$$;$$)
{
    my ($self, $val, $tagInfo, $tag, $wgrp1, $convType, $wantGroup) = @_;
    my ($err, $type);

Conv: for (;;) {
        if (not defined $type) {
            # split value into list if necessary
            if ($$tagInfo{List}) {
                my $listSplit = $$tagInfo{AutoSplit} || $$self{OPTIONS}{ListSplit};
                if (defined $listSplit and not $$tagInfo{Struct} and
                    ($wantGroup or not defined $wantGroup))
                {
                    $listSplit = ',?\s+' if $listSplit eq '1' and $$tagInfo{AutoSplit};
                    my @splitVal = split /$listSplit/, $val;
                    $val = \@splitVal if @splitVal > 1;
                }
            }
            $type = $convType || $$self{ConvType} || 'PrintConv';
        } elsif ($type eq 'PrintConv') {
            $type = 'ValueConv';
        } else {
            # split raw value if necessary
            if ($$tagInfo{RawJoin} and $$tagInfo{List} and not ref $val) {
                my @splitVal = split ' ', $val;
                $val = \@splitVal if @splitVal > 1;
            }
            # finally, do our value check
            my ($err2, $v);
            if ($$tagInfo{WriteCheck}) {
                #### eval WriteCheck ($self, $tagInfo, $val)
                $err2 = eval $$tagInfo{WriteCheck};
                $@ and warn($@), $err2 = 'Error evaluating WriteCheck';
            }
            unless ($err2) {
                my $table = $$tagInfo{Table};
                if ($table and $$table{CHECK_PROC} and not $$tagInfo{RawConvInv}) {
                    my $checkProc = $$table{CHECK_PROC};
                    if (ref $val eq 'ARRAY') {
                        # loop through array values
                        foreach $v (@$val) {
                            $err2 = &$checkProc($self, $tagInfo, \$v);
                            last if $err2;
                        }
                    } else {
                        $err2 = &$checkProc($self, $tagInfo, \$val);
                    }
                }
            }
            if (defined $err2) {
                if ($err2) {
                    $err = "$err2 for $wgrp1:$tag";
                    $self->VPrint(2, "$err\n");
                    undef $val;     # value was invalid
                } else {
                    $err = $err2;   # empty error (quietly don't write tag)
                }
            }
            last;
        }
        my $conv = $$tagInfo{$type};
        my $convInv = $$tagInfo{"${type}Inv"};
        # nothing to do at this level if no conversion defined
        next unless defined $conv or defined $convInv;

        my (@valList, $index, $convList, $convInvList);
        if (ref $val eq 'ARRAY') {
            # handle ValueConv of ListSplit and AutoSplit values
            @valList = @$val;
            $val = $valList[$index = 0];
        } elsif (ref $conv eq 'ARRAY' or ref $convInv eq 'ARRAY') {
            # handle conversion lists
            @valList = split /$listSep{$type}/, $val;
            $val = $valList[$index = 0];
            if (ref $conv eq 'ARRAY') {
                $convList = $conv;
                $conv = $$conv[0];
            }
            if (ref $convInv eq 'ARRAY') {
                $convInvList = $convInv;
                $convInv = $$convInv[0];
            }
        }
        # loop through multiple values if necessary
        for (;;) {
            if ($convInv) {
                # capture eval warnings too
                local $SIG{'__WARN__'} = \&SetWarning;
                undef $evalWarning;
                if (ref($convInv) eq 'CODE') {
                    $val = &$convInv($val, $self);
                } else {
                    #### eval PrintConvInv/ValueConvInv ($val, $self, $wantGroup)
                    $val = eval $convInv;
                    $@ and $evalWarning = $@;
                }
                if ($evalWarning) {
                    # an empty warning ("\n") ignores tag with no error
                    if ($evalWarning eq "\n") {
                        $err = '' unless defined $err;
                    } else {
                        $err = CleanWarning() . " in $wgrp1:$tag (${type}Inv)";
                        $self->VPrint(2, "$err\n");
                    }
                    undef $val;
                    last Conv;
                } elsif (not defined $val) {
                    $err = "Error converting value for $wgrp1:$tag (${type}Inv)";
                    $self->VPrint(2, "$err\n");
                    last Conv;
                }
            } elsif ($conv) {
                if (ref $conv eq 'HASH') {
                    my ($multi, $lc);
                    # insert alternate language print conversions if required
                    if ($$self{CUR_LANG} and $type eq 'PrintConv' and
                        ref($lc = $$self{CUR_LANG}{$tag}) eq 'HASH' and
                        ($lc = $$lc{PrintConv}))
                    {
                        my %newConv;
                        foreach (keys %$conv) {
                            my $val = $$conv{$_};
                            defined $$lc{$val} or $newConv{$_} = $val, next;
                            $newConv{$_} = $self->Decode($$lc{$val}, 'UTF8');
                        }
                        if ($$conv{BITMASK}) {
                            foreach (keys %{$$conv{BITMASK}}) {
                                my $val = $$conv{BITMASK}{$_};
                                defined $$lc{$val} or $newConv{BITMASK}{$_} = $val, next;
                                $newConv{BITMASK}{$_} = $self->Decode($$lc{$val}, 'UTF8');
                            }
                        }
                        $conv = \%newConv;
                    }
                    if ($$conv{BITMASK}) {
                        my $lookupBits = $$conv{BITMASK};
                        my ($wbits, $tbits) = @$tagInfo{'BitsPerWord','BitsTotal'};
                        my ($val2, $err2) = EncodeBits($val, $lookupBits, $wbits, $tbits);
                        if ($err2) {
                            # ok, try matching a straight value
                            ($val, $multi) = ReverseLookup($val, $conv);
                            unless (defined $val) {
                                $err = "Can't encode $wgrp1:$tag ($err2)";
                                $self->VPrint(2, "$err\n");
                                last Conv;
                            }
                        } elsif (defined $val2) {
                            $val = $val2;
                        } else {
                            delete $$conv{BITMASK};
                            ($val, $multi) = ReverseLookup($val, $conv);
                            $$conv{BITMASK} = $lookupBits;
                        }
                    } else {
                        ($val, $multi) = ReverseLookup($val, $conv);
                    }
                    unless (defined $val) {
                        $err = "Can't convert $wgrp1:$tag (" .
                               ($multi ? 'matches more than one' : 'not in') . " $type)";
                        $self->VPrint(2, "$err\n");
                        last Conv;
                    }
                } elsif (not $$tagInfo{WriteAlso}) {
                    $err = "Can't convert value for $wgrp1:$tag (no ${type}Inv)";
                    $self->VPrint(2, "$err\n");
                    undef $val;
                    last Conv;
                }
            }
            last unless @valList;
            $valList[$index] = $val;
            if (++$index >= @valList) {
                # leave AutoSplit lists in ARRAY form, or join conversion lists
                $val = $$tagInfo{List} ? \@valList : join ' ', @valList;
                last;
            }
            $conv = $$convList[$index] if $convList;
            $convInv = $$convInvList[$index] if $convInvList;
            $val = $valList[$index];
        }
    } # end ValueConv/PrintConv loop

    return($val, $err);
}

#------------------------------------------------------------------------------
# convert tag names to values in a string (eg. '${EXIF:ISO}x $$' --> '100x $')
# Inputs: 0) ExifTool object ref, 1) reference to list of found tags
#         2) string with embedded tag names, 3) Options:
#               undef    - set missing tags to ''
#              'Error'   - issue minor error on missing tag (and return undef)
#              'Warn'    - issue minor warning on missing tag (and return undef)
#               Hash ref - hash for return of tag/value pairs
# Returns: string with embedded tag values (or '$info{TAGNAME}' entries with Hash ref option)
# Notes:
# - tag names are not case sensitive and may end with '#' for ValueConv value
# - uses MissingTagValue option if set
# - '$GROUP:all' evaluates to 1 if any tag from GROUP exists, or 0 otherwise
# - advanced feature allows Perl expressions inside braces (eg. '${model;tr/ //d}')
# - an error/warning in an advanced expression ("${TAG;EXPR}") generates an error
#   if option set to 'Error', or a warning otherwise
sub InsertTagValues($$$;$)
{
    local $_;
    my ($self, $foundTags, $line, $opt) = @_;
    my $rtnStr = '';
    while ($line =~ /(.*?)\$(\{\s*)?([-\w]*\w|\$|\/)(.*)/s) {
        my (@tags, $pre, $var, $bra, $val, $tg, @vals, $type, $expr, $level);
        ($pre, $bra, $var, $line) = ($1, $2, $3, $4);
        # "$$" represents a "$" symbol, and "$/" is a newline
        if ($var eq '$' or $var eq '/') {
            $var = "\n" if $var eq '/';
            $rtnStr .= "$pre$var";
            $line =~ s/^\s*\}// if $bra;
            next;
        }
        # allow multiple group names
        while ($line =~ /^:([-\w]*\w)(.*)/s) {
            my $group = $var;
            ($var, $line) = ($1, $2);
            $var = "$group:$var";
        }
        # allow trailing '#' to indicate ValueConv value
        $type = 'ValueConv' if $line =~ s/^#//;
        # remove trailing bracket if there was a leading one
        # and extract Perl expression from inside brackets if it exists
        if ($bra and not $line =~ s/^\s*\}// and $line =~ s/^\s*;\s*(.*?)\}//s) {
            my $part = $1;
            $expr = '';
            for ($level=0; ; --$level) {
                # increase nesting level for each opening brace
                ++$level while $part =~ /\{/g;
                $expr .= $part;
                last unless $level and $line =~ s/^(.*?)\}//s; # get next part
                $part = $1;
                $expr .= '}';  # this brace was part of the expression
            }
            # use default Windows filename filter if expression is empty
            $expr = 'tr(/\\\\?*:|"<>\\0)()d' unless length $expr;
        }
        push @tags, $var;
        ExpandShortcuts(\@tags);
        @tags or $rtnStr .= $pre, next;

        for (;;) {
            my $tag = shift @tags;
            my $lcTag = lc $tag;
            if ($lcTag eq 'all') {
                $val = 1;   # always some tag available
            } elsif (defined $$self{OPTIONS}{UserParam}{$lcTag}) {
                $val = $$self{OPTIONS}{UserParam}{$lcTag};
            } elsif ($tag =~ /(.*):(.+)/) {
                my $group;
                ($group, $tag) = ($1, $2);
                if (lc $tag eq 'all') {
                    # see if any tag from the specified group exists
                    my $match = $self->GroupMatches($group, $foundTags);
                    $val = $match ? 1 : 0;
                } else {
                    # find the specified tag
                    my @matches = grep /^$tag(\s|$)/i, @$foundTags;
                    @matches = $self->GroupMatches($group, \@matches);
                    foreach $tg (@matches) {
                        if (defined $val and $tg =~ / \((\d+)\)$/) {
                            # take the most recently extracted tag
                            my $tagNum = $1;
                            next if $tag !~ / \((\d+)\)$/ or $1 > $tagNum;
                        }
                        $val = $self->GetValue($tg, $type);
                        $tag = $tg;
                        last unless $tag =~ / /;    # all done if we got our best match
                    }
                }
            } else {
                # get the tag value
                $val = $self->GetValue($tag, $type);
                unless (defined $val) {
                    # check for tag name with different case
                    ($tg) = grep /^$tag$/i, @$foundTags;
                    if (defined $tg) {
                        $val = $self->GetValue($tg, $type);
                        $tag = $tg;
                    }
                }
            }
            if (ref $val eq 'ARRAY') {
                $val = join($$self{OPTIONS}{ListSep}, @$val);
            } elsif (ref $val eq 'SCALAR') {
                if ($$self{OPTIONS}{Binary} or $$val =~ /^Binary data/) {
                    $val = $$val;
                } else {
                    $val = 'Binary data ' . length($$val) . ' bytes';
                }
            } elsif (ref $val eq 'HASH') {
                require 'Image/ExifTool/XMPStruct.pl';
                $val = Image::ExifTool::XMP::SerializeStruct($val);
            } elsif (not defined $val) {
                last unless @tags;
                next;
            }
            # evaluate advanced formatting expression if given (eg. "${TAG;EXPR}")
            if (defined $expr) {
                local $SIG{'__WARN__'} = \&SetWarning;
                undef $evalWarning;
                $_ = $val;
                #### eval translation expression ($_, $self)
                eval $expr;
                $val = $_;
                $@ and $evalWarning = $@;
                if ($evalWarning) {
                    my $str = CleanWarning() . " for $tag";
                    ($opt and $opt eq 'Error') ? $self->Error($str) : $self->Warn($str);
                }
            }
            last unless @tags;
            push @vals, $val;
            undef $val;
        }
        if (@vals) {
            push @vals, $val if defined $val;
            $val = join '', @vals;
        }
        unless (defined $val or ref $opt) {
            $val = $$self{OPTIONS}{MissingTagValue};
            unless (defined $val) {
                no strict 'refs';
                return undef if $opt and &$opt($self, "Tag '$var' not defined", 2);
                $val = '';
            }
        }
        if (ref $opt eq 'HASH') {
            $var .= '#' if $type;
            if (defined $expr) {
                # generate unique variable name for this modified tag value
                my $i = 1;
                ++$i while exists $$opt{"$val.expr$i"};
                $var .= '.expr' . $i;
            }
            $rtnStr .= "$pre\$info{'$var'}";
            $$opt{$var} = $val;
        } else {
            $rtnStr .= "$pre$val";
        }
    }
    return $rtnStr . $line;
}

#------------------------------------------------------------------------------
# Is specified tag writable
# Inputs: 0) tag name, case insensitive (optional group name currently ignored)
# Returns: 0=exists but not writable, 1=writable, undef=doesn't exist
sub IsWritable($)
{
    my $tag = shift;
    $tag =~ s/^(.*)://; # ignore group name
    my @tagInfo = FindTagInfo($tag);
    unless (@tagInfo) {
        return 0 if TagExists($tag);
        return undef;
    }
    my $tagInfo;
    foreach $tagInfo (@tagInfo) {
        return $$tagInfo{Writable} ? 1 : 0 if defined $$tagInfo{Writable};
        return 1 if $$tagInfo{Table}{WRITABLE};
        # must call WRITE_PROC to autoload writer because this may set the writable tag
        my $writeProc = $$tagInfo{Table}{WRITE_PROC};
        next unless $writeProc;
        &$writeProc();  # dummy call to autoload writer
        return 1 if $$tagInfo{Writable};
    }
    return 0;
}

#------------------------------------------------------------------------------
# Create directory for specified file
# Inputs: 0) ExifTool ref, 1) complete file name including path
# Returns: 1 = directory created, 0 = nothing done, -1 = error
my $k32CreateDir;
sub CreateDirectory($$)
{
    local $_;
    my ($self, $file) = @_;
    my $rtnVal = 0;
    my $enc = $$self{OPTIONS}{CharsetFileName};
    my $dir;
    ($dir = $file) =~ s/[^\/]*$//;  # remove filename from path specification
    # recode as UTF-8 if necessary
    if ($dir and not $self->IsDirectory($dir)) {
        my @parts = split /\//, $dir;
        $dir = '';
        foreach (@parts) {
            $dir .= $_;
            if (length $dir and not $self->IsDirectory($dir)) {
                # create directory since it doesn't exist
                my $d2 = $dir; # (must make a copy in case EncodeFileName recodes it)
                if ($self->EncodeFileName($d2)) {
                    # handle Windows Unicode directory names
                    unless (eval { require Win32::API }) {
                        $self->Warn('Install Win32::API to create directories with Unicode names');
                        return -1;
                    }
                    unless ($k32CreateDir) {
                        return -1 if defined $k32CreateDir;
                        $k32CreateDir = new Win32::API('KERNEL32', 'CreateDirectoryW', 'PP', 'I');
                        unless ($k32CreateDir) {
                            $self->Warn('Error calling Win32::API::CreateDirectoryW');
                            $k32CreateDir = 0;
                            return -1;
                        }
                    }
                    $k32CreateDir->Call($d2, 0) or return -1;
                } else {
                    mkdir($d2, 0777) or return -1;
                }
                $rtnVal = 1;
            }
            $dir .= '/';
        }
    }
    return $rtnVal;
}

#------------------------------------------------------------------------------
# Copy file attributes from one file to another
# Inputs: 0) source file name, 1) destination file name
# Notes: eventually add support for extended attributes?
sub CopyFileAttrs($$)
{
    my ($src, $dst) = @_;
    my ($mode, $uid, $gid) = (stat($src))[2, 4, 5];
    eval { chmod($mode & 07777, $dst) } if defined $mode;
    eval { chown($uid, $gid, $dst) } if defined $uid and defined $gid;
}

#------------------------------------------------------------------------------
# Get new file path name
# Inputs: 0) existing name (may contain directory),
#         1) new file name, new directory, or new path (dir+name)
# Returns: new file path name
sub GetNewFileName($$)
{
    my ($oldName, $newName) = @_;
    my ($dir, $name) = ($oldName =~ m{(.*/)(.*)});
    ($dir, $name) = ('', $oldName) unless defined $dir;
    if ($newName =~ m{/$}) {
        $newName = "$newName$name"; # change dir only
    } elsif ($newName !~ m{/}) {
        $newName = "$dir$newName";  # change name only if newname doesn't specify dir
    }                               # else change dir and name
    return $newName;
}

#------------------------------------------------------------------------------
# Get next available tag key
# Inputs: 0) hash reference (keys are tag keys), 1) tag name
# Returns: next available tag key
sub NextFreeTagKey($$)
{
    my ($info, $tag) = @_;
    return $tag unless exists $$info{$tag};
    my $i;
    for ($i=1; ; ++$i) {
        my $key = "$tag ($i)";
        return $key unless exists $$info{$key};
    }
}

#------------------------------------------------------------------------------
# Reverse hash lookup
# Inputs: 0) value, 1) hash reference
# Returns: Hash key or undef if not found (plus flag for multiple matches in list context)
sub ReverseLookup($$)
{
    my ($val, $conv) = @_;
    return undef unless defined $val;
    my $multi;
    if ($val =~ /^Unknown\s*\((.*)\)$/i) {
        $val = $1;    # was unknown
        if ($val =~ /^0x([\da-fA-F]+)$/) {
            $val = hex($val);   # convert hex value
        }
    } else {
        my $qval = $val;
        $qval =~ s/\s+$//;      # remove trailing whitespace
        $qval = quotemeta $qval;
        my @patterns = (
            "^$qval\$",         # exact match
            "^(?i)$qval\$",     # case-insensitive
            "^(?i)$qval",       # beginning of string
            "(?i)$qval",        # substring
        );
        # hash entries to ignore in reverse lookup
        my ($pattern, $found, $matches);
PAT:    foreach $pattern (@patterns) {
            $matches = scalar grep /$pattern/, values(%$conv);
            next unless $matches;
            # multiple matches are bad unless they were exact
            if ($matches > 1 and $pattern !~ /\$$/) {
                # don't match entries that we should ignore
                foreach (keys %ignorePrintConv) {
                    --$matches if defined $$conv{$_} and $$conv{$_} =~ /$pattern/;
                }
                last if $matches > 1;
            }
            foreach (sort keys %$conv) {
                next if $$conv{$_} !~ /$pattern/ or $ignorePrintConv{$_};
                $val = $_;
                $found = 1;
                last PAT;
            }
        }
        unless ($found) {
            # call OTHER conversion routine if available
            $val = $$conv{OTHER} ? &{$$conv{OTHER}}($val,1,$conv) : undef;
            $multi = 1 if $matches > 1;
        }
    }
    return ($val, $multi) if wantarray;
    return $val;
}

#------------------------------------------------------------------------------
# Return true if we are deleting or overwriting the specified tag
# Inputs: 0) ExifTool object ref, 1) new value hash reference
#         2) optional tag value (before RawConv) if deleting specific values
# Returns: >0 - tag should be overwritten
#          =0 - the tag should be preserved
#          <0 - not sure, we need the value to know
sub IsOverwriting($$;$)
{
    my ($self, $nvHash, $val) = @_;
    return 0 unless $nvHash;
    # overwrite regardless if no DelValues specified
    return 1 unless $$nvHash{DelValue};
    # never overwrite if DelValue list exists but is empty
    my $shift = $$nvHash{Shift};
    return 0 unless @{$$nvHash{DelValue}} or defined $shift;
    # return "don't know" if we don't have a value to test
    return -1 unless defined $val;
    # apply raw conversion if necessary
    my $tagInfo = $$nvHash{TagInfo};
    my $conv = $$tagInfo{RawConv};
    if ($conv) {
        local $SIG{'__WARN__'} = \&SetWarning;
        undef $evalWarning;
        if (ref $conv eq 'CODE') {
            $val = &$conv($val, $self);
        } else {
            my $tag = $$tagInfo{Name};
            #### eval RawConv ($self, $val, $tag, $tagInfo)
            $val = eval $conv;
            $@ and $evalWarning = $@;
        }
        return -1 unless defined $val;
    }
    # do not overwrite if only creating
    return 0 if $$nvHash{CreateOnly};
    # apply time/number shift if necessary
    if (defined $shift) {
        my $shiftType = $$tagInfo{Shift};
        unless ($shiftType and $shiftType eq 'Time') {
            unless (IsFloat($val)) {
                $self->Warn("Can't shift $$tagInfo{Name} (not a number)");
                return 0;
            }
            $shiftType = 'Number';  # allow any number to be shifted
        }
        require 'Image/ExifTool/Shift.pl';
        my $err = $self->ApplyShift($shiftType, $shift, $val, $nvHash);
        if ($err) {
            $self->Warn("$err when shifting $$tagInfo{Name}");
            return 0;
        }
        # ensure that the shifted value is valid and reformat if necessary
        my $checkVal = $self->GetNewValue($nvHash);
        return 0 unless defined $checkVal;
        # don't bother overwriting if value is the same
        return 0 if $val eq $$nvHash{Value}[0];
        return 1;
    }
    # return 1 if value matches a DelValue
    my $delVal;
    foreach $delVal (@{$$nvHash{DelValue}}) {
        return 1 if $val eq $delVal;
    }
    return 0;
}

#------------------------------------------------------------------------------
# Get write group for specified tag
# Inputs: 0) new value hash reference
# Returns: Write group name
sub GetWriteGroup($)
{
    return $_[0]{WriteGroup};
}

#------------------------------------------------------------------------------
# Get name of write group or family 1 group
# Inputs: 0) ExifTool ref, 1) tagInfo ref, 2) write group name
# Returns: Name of group for verbose message
sub GetWriteGroup1($$)
{
    my ($self, $tagInfo, $writeGroup) = @_;
    return $writeGroup unless $writeGroup =~ /^(MakerNotes|XMP|Composite)$/;
    return $self->GetGroup($tagInfo, 1);
}

#------------------------------------------------------------------------------
# Get new value hash for specified tagInfo/writeGroup
# Inputs: 0) ExifTool object reference, 1) reference to tag info hash
#         2) Write group name, 3) Options: 'delete' or 'create'
#         4) optional ProtectSaved value
# Returns: new value hash reference for specified write group
#          (or first new value hash in linked list if write group not specified)
# Notes: May return undef when 'create' is used with ProtectSaved
sub GetNewValueHash($$;$$$)
{
    my ($self, $tagInfo, $writeGroup, $opts) = @_;
    my $nvHash = $$self{NEW_VALUE}{$tagInfo};

    my %opts;   # quick lookup for options
    $opts and $opts{$opts} = 1;
    $writeGroup = '' unless defined $writeGroup;

    if ($writeGroup) {
        # find the new value in the list with the specified write group
        # (QuickTime is a special case because all group1 tags may be updated at once)
        while ($nvHash and $$nvHash{WriteGroup} ne $writeGroup and
            $$nvHash{WriteGroup} ne 'QuickTime')
        {
            $nvHash = $$nvHash{Next};
        }
    }
    # remove this entry if deleting, or if creating a new entry and
    # this entry is marked with "Save" flag
    if (defined $nvHash and ($opts{'delete'} or ($opts{'create'} and $$nvHash{Save}))) {
        my $protect = (defined $_[4] and defined $$nvHash{Save} and $$nvHash{Save} > $_[4]);
        if ($protect and not ($$nvHash{NoReplace} and $opts{create})) {
            return undef;   # honour ProtectSaved value by not writing this tag
        } elsif ($opts{'delete'}) {
            $self->RemoveNewValueHash($nvHash, $tagInfo);
            undef $nvHash;
        } else {
            # save a copy of this new value hash
            my %copy = %$nvHash;
            # make copy of Value and DelValue lists
            my $key;
            foreach $key (keys %copy) {
                next unless ref $copy{$key} eq 'ARRAY';
                $copy{$key} = [ @{$copy{$key}} ];
            }
            my $saveHash = $$self{SAVE_NEW_VALUE};
            # add to linked list of saved new value hashes
            $copy{Next} = $$saveHash{$tagInfo};
            $$saveHash{$tagInfo} = \%copy;
            delete $$nvHash{Save}; # don't save it again
            $$nvHash{AddBefore} = scalar @{$$nvHash{Value}} if $protect and $$nvHash{Value};
        }
    }
    if (not defined $nvHash and $opts{'create'}) {
        # create a new entry
        $nvHash = {
            TagInfo => $tagInfo,
            WriteGroup => $writeGroup,
            IsNVH => 1, # set flag so we can recognize a new value hash
        };
        # add entry to our NEW_VALUE hash
        if ($$self{NEW_VALUE}{$tagInfo}) {
            # add to end of linked list
            my $lastHash = LastInList($$self{NEW_VALUE}{$tagInfo});
            $$lastHash{Next} = $nvHash;
        } else {
            $$self{NEW_VALUE}{$tagInfo} = $nvHash;
        }
    }
    return $nvHash;
}

#------------------------------------------------------------------------------
# Load all tag tables
sub LoadAllTables()
{
    return if $loadedAllTables;

    # load all of our non-referenced tables (first our modules)
    my $table;
    foreach $table (@loadAllTables) {
        my $tableName = "Image::ExifTool::$table";
        $tableName .= '::Main' unless $table =~ /:/;
        GetTagTable($tableName);
    }
    # (then our special tables)
    GetTagTable('Image::ExifTool::Extra');
    GetTagTable('Image::ExifTool::Composite');
    # recursively load all tables referenced by the current tables
    my @tableNames = keys %allTables;
    my %pushedTables;
    while (@tableNames) {
        $table = GetTagTable(shift @tableNames);
        # call write proc if it exists in case it adds tags to the table
        my $writeProc = $$table{WRITE_PROC};
        $writeProc and &$writeProc();
        # recursively scan through tables in subdirectories
        foreach (TagTableKeys($table)) {
            my @infoArray = GetTagInfoList($table,$_);
            my $tagInfo;
            foreach $tagInfo (@infoArray) {
                my $subdir = $$tagInfo{SubDirectory} or next;
                my $tableName = $$subdir{TagTable} or next;
                # next if table already loaded or queued for loading
                next if $allTables{$tableName} or $pushedTables{$tableName};
                push @tableNames, $tableName;   # must scan this one too
                $pushedTables{$tableName} = 1;
            }
        }
    }
    $loadedAllTables = 1;
}

#------------------------------------------------------------------------------
# Remove new value hash from linked list (and save if necessary)
# Inputs: 0) ExifTool object reference, 1) new value hash ref, 2) tagInfo ref
sub RemoveNewValueHash($$$)
{
    my ($self, $nvHash, $tagInfo) = @_;
    my $firstHash = $$self{NEW_VALUE}{$tagInfo};
    if ($nvHash eq $firstHash) {
        # remove first entry from linked list
        if ($$nvHash{Next}) {
            $$self{NEW_VALUE}{$tagInfo} = $$nvHash{Next};
        } else {
            delete $$self{NEW_VALUE}{$tagInfo};
        }
    } else {
        # find the list element pointing to this hash
        $firstHash = $$firstHash{Next} while $$firstHash{Next} ne $nvHash;
        # remove from linked list
        $$firstHash{Next} = $$nvHash{Next};
    }
    # save the existing entry if necessary
    if ($$nvHash{Save}) {
        my $saveHash = $$self{SAVE_NEW_VALUE};
        # add to linked list of saved new value hashes
        $$nvHash{Next} = $$saveHash{$tagInfo};
        $$saveHash{$tagInfo} = $nvHash;
    }
}

#------------------------------------------------------------------------------
# Remove all new value entries for specified group
# Inputs: 0) ExifTool object reference, 1) group name
sub RemoveNewValuesForGroup($$)
{
    my ($self, $group) = @_;

    return unless $$self{NEW_VALUE};

    # make list of all groups we must remove
    my @groups = ( $group );
    push @groups, @{$removeGroups{$group}} if $removeGroups{$group};

    my ($out, @keys, $hashKey);
    $out = $$self{OPTIONS}{TextOut} if $$self{OPTIONS}{Verbose} > 1;

    # loop though all new values, and remove any in this group
    @keys = keys %{$$self{NEW_VALUE}};
    foreach $hashKey (@keys) {
        my $nvHash = $$self{NEW_VALUE}{$hashKey};
        # loop through each entry in linked list
        for (;;) {
            my $nextHash = $$nvHash{Next};
            my $tagInfo = $$nvHash{TagInfo};
            my ($grp0,$grp1) = $self->GetGroup($tagInfo);
            my $wgrp = $$nvHash{WriteGroup};
            # use group1 if write group is not specific
            $wgrp = $grp1 if $wgrp eq $grp0;
            if (grep /^($grp0|$wgrp)$/i, @groups) {
                $out and print $out "Removed new value for $wgrp:$$tagInfo{Name}\n";
                # remove from linked list
                $self->RemoveNewValueHash($nvHash, $tagInfo);
            }
            $nvHash = $nextHash or last;
        }
    }
}

#------------------------------------------------------------------------------
# Get list of tagInfo hashes for all new data
# Inputs: 0) ExifTool object reference, 1) optional tag table pointer
# Returns: list of tagInfo hashes
sub GetNewTagInfoList($;$)
{
    my ($self, $tagTablePtr) = @_;
    my @tagInfoList;
    my $nv = $$self{NEW_VALUE};
    if ($nv) {
        my $hashKey;
        foreach $hashKey (keys %$nv) {
            my $tagInfo = $$nv{$hashKey}{TagInfo};
            next if $tagTablePtr and $tagTablePtr ne $$tagInfo{Table};
            push @tagInfoList, $tagInfo;
        }
    }
    return @tagInfoList;
}

#------------------------------------------------------------------------------
# Get hash of tagInfo references keyed on tagID for a specific table
# Inputs: 0) ExifTool object reference, 1-N) tag table pointers
# Returns: hash reference
# Notes: returns only one tagInfo ref for each conditional list
sub GetNewTagInfoHash($@)
{
    my $self = shift;
    my (%tagInfoHash, $hashKey);
    my $nv = $$self{NEW_VALUE};
    while ($nv) {
        my $tagTablePtr = shift || last;
        foreach $hashKey (keys %$nv) {
            my $tagInfo = $$nv{$hashKey}{TagInfo};
            next if $tagTablePtr and $tagTablePtr ne $$tagInfo{Table};
            $tagInfoHash{$$tagInfo{TagID}} = $tagInfo;
        }
    }
    return \%tagInfoHash;
}

#------------------------------------------------------------------------------
# Get a tagInfo/tagID hash for subdirectories we need to add
# Inputs: 0) ExifTool object reference, 1) parent tag table reference
#         2) parent directory name (taken from GROUP0 of tag table if not defined)
# Returns: Reference to Hash of subdirectory tagInfo references keyed by tagID
#          (plus Reference to edit directory hash in list context)
sub GetAddDirHash($$;$)
{
    my ($self, $tagTablePtr, $parent) = @_;
    $parent or $parent = $$tagTablePtr{GROUPS}{0};
    my $tagID;
    my %addDirHash;
    my %editDirHash;
    my $addDirs = $$self{ADD_DIRS};
    my $editDirs = $$self{EDIT_DIRS};
    foreach $tagID (TagTableKeys($tagTablePtr)) {
        my @infoArray = GetTagInfoList($tagTablePtr,$tagID);
        my $tagInfo;
        foreach $tagInfo (@infoArray) {
            next unless $$tagInfo{SubDirectory};
            # get name for this sub directory
            # (take directory name from SubDirectory DirName if it exists,
            #  otherwise Group0 name of SubDirectory TagTable or tag Group1 name)
            my $dirName = $$tagInfo{SubDirectory}{DirName};
            unless ($dirName) {
                # use tag name for directory name and save for next time
                $dirName = $$tagInfo{Name};
                $$tagInfo{SubDirectory}{DirName} = $dirName;
            }
            # save this directory information if we are writing it
            if ($$editDirs{$dirName} and $$editDirs{$dirName} eq $parent) {
                $editDirHash{$tagID} = $tagInfo;
                $addDirHash{$tagID} = $tagInfo if $$addDirs{$dirName};
            }
        }
    }
    return (\%addDirHash, \%editDirHash) if wantarray;
    return \%addDirHash;
}

#------------------------------------------------------------------------------
# Get localized version of tagInfo hash (used by MIE, XMP, PNG and QuickTime)
# Inputs: 0) tagInfo hash ref, 1) locale code (eg. "en_CA" for MIE)
# Returns: new tagInfo hash ref, or undef if invalid
# - sets LangCode member in new tagInfo
sub GetLangInfo($$)
{
    my ($tagInfo, $langCode) = @_;
    # make a new tagInfo hash for this locale
    my $table = $$tagInfo{Table};
    my $tagID = $$tagInfo{TagID} . '-' . $langCode;
    my $langInfo = $$table{$tagID};
    unless ($langInfo) {
        # make a new tagInfo entry for this locale
        $langInfo = {
            %$tagInfo,
            Name => $$tagInfo{Name} . '-' . $langCode,
            Description => Image::ExifTool::MakeDescription($$tagInfo{Name}) .
                           " ($langCode)",
            LangCode => $langCode,
            SrcTagInfo => $tagInfo, # save reference to original tagInfo
        };
        AddTagToTable($table, $tagID, $langInfo);
    }
    return $langInfo;
}

#------------------------------------------------------------------------------
# initialize ADD_DIRS and EDIT_DIRS hashes for all directories that need
# need to be created or will have tags changed in them
# Inputs: 0) ExifTool object reference, 1) file type string (or map hash ref)
#         2) preferred family 0 group name for creating tags
# Notes: The ADD_DIRS and EDIT_DIRS keys are the directory names, and the values
#        are the names of the parent directories (undefined for a top-level directory)
sub InitWriteDirs($$;$)
{
    my ($self, $fileType, $preferredGroup) = @_;
    my $editDirs = $$self{EDIT_DIRS} = { };
    my $addDirs = $$self{ADD_DIRS} = { };
    my $fileDirs = $dirMap{$fileType};
    unless ($fileDirs) {
        return unless ref $fileType eq 'HASH';
        $fileDirs = $fileType;
    }
    my @tagInfoList = $self->GetNewTagInfoList();
    my ($tagInfo, $nvHash);

    # save the preferred group
    $$self{PreferredGroup} = $preferredGroup;

    foreach $tagInfo (@tagInfoList) {
        # cycle through all hashes in linked list
        for ($nvHash=$self->GetNewValueHash($tagInfo); $nvHash; $nvHash=$$nvHash{Next}) {
            # are we creating this tag? (otherwise just deleting or editing it)
            my $isCreating = $$nvHash{IsCreating};
            if ($isCreating) {
                # if another group is taking priority, only create
                # directory if specifically adding tags to this group
                # or if this tag isn't being added to the priority group
                $isCreating = 0 if $preferredGroup and
                    $preferredGroup ne $self->GetGroup($tagInfo, 0) and
                    $$nvHash{CreateGroups}{$preferredGroup};
            } else {
                # creating this directory if any tag is preferred and has a value
                $isCreating = 1 if ($preferredGroup and $$nvHash{Value} and
                    $preferredGroup eq $self->GetGroup($tagInfo, 0)) and
                    not $$nvHash{EditOnly};
            }
            # tag belongs to directory specified by WriteGroup, or by
            # the Group0 name if WriteGroup not defined
            my $dirName = $$nvHash{WriteGroup};
            # remove MIE copy number(s) if they exist
            if ($dirName =~ /^MIE\d*(-[a-z]+)?\d*$/i) {
                $dirName = 'MIE' . ($1 || '');
            }
            my @dirNames;
            while ($dirName) {
                my $parent = $$fileDirs{$dirName};
                if (ref $parent) {
                    push @dirNames, reverse @$parent;
                    $parent = pop @dirNames;
                }
                $$editDirs{$dirName} = $parent;
                $$addDirs{$dirName} = $parent if $isCreating and $isCreating != 2;
                $dirName = $parent || shift @dirNames
            }
        }
    }
    if (%{$$self{DEL_GROUP}}) {
        # add delete groups to list of edited groups
        foreach (keys %{$$self{DEL_GROUP}}) {
            next if /^-/;   # ignore excluded groups
            my $dirName = $_;
            # translate necessary group 0 names
            $dirName = $translateWriteGroup{$dirName} if $translateWriteGroup{$dirName};
            # convert XMP group 1 names
            $dirName = 'XMP' if $dirName =~ /^XMP-/;
            my @dirNames;
            while ($dirName) {
                my $parent = $$fileDirs{$dirName};
                if (ref $parent) {
                    push @dirNames, reverse @$parent;
                    $parent = pop @dirNames;
                }
                $$editDirs{$dirName} = $parent;
                $dirName = $parent || shift @dirNames
            }
        }
    }
    # special case to edit JFIF to get resolutions if editing EXIF information
    if ($$editDirs{IFD0} and $$fileDirs{JFIF}) {
        $$editDirs{JFIF} = 'IFD1';
        $$editDirs{APP0} = undef;
    }

    if ($$self{OPTIONS}{Verbose}) {
        my $out = $$self{OPTIONS}{TextOut};
        print $out "  Editing tags in: ";
        foreach (sort keys %$editDirs) { print $out "$_ "; }
        print $out "\n";
        return unless $$self{OPTIONS}{Verbose} > 1;
        print $out "  Creating tags in: ";
        foreach (sort keys %$addDirs) { print $out "$_ "; }
        print $out "\n";
    }
}

#------------------------------------------------------------------------------
# Write an image directory
# Inputs: 0) ExifTool object reference, 1) source directory information reference
#         2) tag table reference, 3) optional reference to writing procedure
# Returns: New directory data or undefined on error
sub WriteDirectory($$$;$)
{
    my ($self, $dirInfo, $tagTablePtr, $writeProc) = @_;
    my ($out, $nvHash);

    $tagTablePtr or return undef;
    $out = $$self{OPTIONS}{TextOut} if $$self{OPTIONS}{Verbose};
    # set directory name from default group0 name if not done already
    my $dirName = $$dirInfo{DirName};
    my $dataPt = $$dirInfo{DataPt};
    my $grp0 = $$tagTablePtr{GROUPS}{0};
    $dirName or $dirName = $$dirInfo{DirName} = $grp0;
    if (%{$$self{DEL_GROUP}}) {
        my $delGroup = $$self{DEL_GROUP};
        # delete entire directory if specified
        my $grp1 = $dirName;
        my $delFlag = ($$delGroup{$grp0} or $$delGroup{$grp1});
        if ($delFlag) {
            unless ($blockExifTypes{$$self{FILE_TYPE}}) {
                # restrict delete logic to prevent entire tiff image from being killed
                # (don't allow IFD0 to be deleted, and delete only ExifIFD if EXIF specified)
                if ($$self{FILE_TYPE} eq 'PSD') {
                    # don't delete Photoshop directories from PSD image
                    undef $grp1 if $grp0 eq 'Photoshop';
                } elsif ($$self{FILE_TYPE} =~ /^(EPS|PS)$/) {
                    # allow anything to be deleted from PostScript files
                } elsif ($grp1 eq 'IFD0') {
                    my $type = $$self{TIFF_TYPE} || $$self{FILE_TYPE};
                    $$delGroup{IFD0} and $self->Warn("Can't delete IFD0 from $type",1);
                    undef $grp1;
                } elsif ($grp0 eq 'EXIF' and $$delGroup{$grp0}) {
                    undef $grp1 unless $$delGroup{$grp1} or $grp1 eq 'ExifIFD';
                }
            }
            if ($grp1) {
                if ($dataPt or $$dirInfo{RAF}) {
                    ++$$self{CHANGED};
                    $out and print $out "  Deleting $grp1\n";
                    # can no longer validate TIFF_END if deleting an entire IFD
                    delete $$self{TIFF_END} if $dirName =~ /IFD/;
                }
                # don't add back into the wrong location
                my $right = $$self{ADD_DIRS}{$grp1};
                # (take care because EXIF directory name may be either EXIF or IFD0,
                #  but IFD0 will be the one that appears in the directory map)
                $right = $$self{ADD_DIRS}{IFD0} if not $right and $grp1 eq 'EXIF';
                if ($delFlag == 2 and $right) {
                    # also check grandparent because some routines create 2 levels in 1
                    my $right2 = $$self{ADD_DIRS}{$right} || '';
                    my $parent = $$dirInfo{Parent};
                    if (not $parent or $parent eq $right or $parent eq $right2) {
                        # prevent duplicate directories from being recreated at the same path
                        my $path = join '-', @{$$self{PATH}}, $dirName;
                        $$self{Recreated} or $$self{Recreated} = { };
                        if ($$self{Recreated}{$path}) {
                            my $p = $parent ? " in $parent" : '';
                            $self->Warn("Not recreating duplicate $grp1$p",1);
                            return '';
                        }
                        $$self{Recreated}{$path} = 1;
                        # empty the directory
                        my $data = '';
                        $$dirInfo{DataPt}   = \$data;
                        $$dirInfo{DataLen}  = 0;
                        $$dirInfo{DirStart} = 0;
                        $$dirInfo{DirLen}   = 0;
                        delete $$dirInfo{RAF};
                        delete $$dirInfo{Base};
                        delete $$dirInfo{DataPos};
                    } else {
                        $self->Warn("Not recreating $grp1 in $parent (should be in $right)",1);
                        return '';
                    }
                } else {
                    return '' unless $$dirInfo{NoDelete};
                }
            }
        }
    }
    # use default proc from tag table if no proc specified
    $writeProc or $writeProc = $$tagTablePtr{WRITE_PROC} or return undef;

    # are we rewriting a pre-existing directory?
    my $isRewriting = ($$dirInfo{DirLen} or (defined $dataPt and length $$dataPt) or $$dirInfo{RAF});

    # copy or delete new directory as a block if specified
    my $blockName = $dirName;
    $blockName = 'EXIF' if $blockName eq 'IFD0';
    my $tagInfo = $Image::ExifTool::Extra{$blockName} || $$dirInfo{TagInfo};
    while ($tagInfo and ($nvHash = $$self{NEW_VALUE}{$tagInfo}) and
        $self->IsOverwriting($nvHash) and not ($$nvHash{CreateOnly} and $isRewriting))
    {
        # protect against writing EXIF to wrong file types, etc
        if ($blockName eq 'EXIF') {
            unless ($blockExifTypes{$$self{FILE_TYPE}}) {
                $self->Warn("Can't write EXIF as a block to $$self{FILE_TYPE} file");
                last;
            }
            # this can happen if we call WriteDirectory for an EXIF directory without  going
            # through WriteTIFF as the WriteProc (which happens if conditionally replacing
            # the EXIF block and the condition fails), but we never want to do a block write
            # in this case because the EXIF block would end up with two TIFF headers
            last unless $writeProc eq \&Image::ExifTool::WriteTIFF;
        }
        last unless $self->IsOverwriting($nvHash, $dataPt ? $$dataPt : '');
        my $verb = 'Writing';
        my $newVal = $self->GetNewValue($nvHash);
        unless (defined $newVal and length $newVal) {
            return '' unless $dataPt or $$dirInfo{RAF}; # nothing to do if block never existed
            $verb = 'Deleting';
            $newVal = '';
        }
        $$dirInfo{BlockWrite} = 1;  # set flag indicating we did a block write
        $out and print $out "  $verb $blockName as a block\n";
        ++$$self{CHANGED};
        return $newVal;
    }
    # guard against writing the same directory twice
    if (defined $dataPt and defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos}) {
        my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0) + $$self{BASE};
        # (Phase One P25 IIQ files have ICC_Profile duplicated in IFD0 and IFD1)
        if ($$self{PROCESSED}{$addr} and ($dirName ne 'ICC_Profile' or $$self{TIFF_TYPE} ne 'IIQ')) {
            if (defined $$dirInfo{DirLen} and not $$dirInfo{DirLen} and $dirName ne $$self{PROCESSED}{$addr}) {
                # it is hypothetically possible to have 2 different directories
                # with the same address if one has a length of zero
            } elsif ($self->Error("$dirName pointer references previous $$self{PROCESSED}{$addr} directory", 2)) {
                return undef;
            } else {
                $self->Warn("Deleting duplicate $dirName directory");
                $out and print $out "  Deleting $dirName\n";
                return '';  # delete the duplicate directory
            }
        } else {
            $$self{PROCESSED}{$addr} = $dirName;
        }
    }
    my $oldDir = $$self{DIR_NAME};
    my $name;
    if ($out) {
        $name = ($dirName eq 'MakerNotes' and $$dirInfo{TagInfo}) ?
                 $$dirInfo{TagInfo}{Name} : $dirName;
        if (not defined $oldDir or $oldDir ne $name) {
            my $verb = $isRewriting ? 'Rewriting' : 'Creating';
            print $out "  $verb $name\n";
        }
    }
    my $saveOrder = GetByteOrder();
    my $oldChanged = $$self{CHANGED};
    $$self{DIR_NAME} = $dirName;
    push @{$$self{PATH}}, $dirName;
    $$dirInfo{IsWriting} = 1;
    my $newData = &$writeProc($self, $dirInfo, $tagTablePtr);
    pop @{$$self{PATH}};
    # nothing changed if error occurred or nothing was created
    $$self{CHANGED} = $oldChanged unless defined $newData and (length($newData) or $isRewriting);
    $$self{DIR_NAME} = $oldDir;
    SetByteOrder($saveOrder);
    print $out "  Deleting $name\n" if $out and defined $newData and not length $newData;
    return $newData;
}

#------------------------------------------------------------------------------
# Uncommon utility routines to for reading binary data values
# Inputs: 0) data reference, 1) offset into data
sub Get64s($$)
{
    my ($dataPt, $pos) = @_;
    my $pt = GetByteOrder() eq 'MM' ? 0 : 4;    # get position of high word
    my $hi = Get32s($dataPt, $pos + $pt);       # preserve sign bit of high word
    my $lo = Get32u($dataPt, $pos + 4 - $pt);
    return $hi * 4294967296 + $lo;
}
sub Get64u($$)
{
    my ($dataPt, $pos) = @_;
    my $pt = GetByteOrder() eq 'MM' ? 0 : 4;    # get position of high word
    my $hi = Get32u($dataPt, $pos + $pt);       # (unsigned this time)
    my $lo = Get32u($dataPt, $pos + 4 - $pt);
    return $hi * 4294967296 + $lo;
}
# Decode extended 80-bit float used by Apple SANE and Intel 8087
# (note: different than the IEEE standard 80-bit float)
sub GetExtended($$)
{
    my ($dataPt, $pos) = @_;
    my $pt = GetByteOrder() eq 'MM' ? 0 : 2;    # get position of exponent
    my $exp = Get16u($dataPt, $pos + $pt);
    my $sig = Get64u($dataPt, $pos + 2 - $pt);  # get significand as int64u
    my $sign = $exp & 0x8000 ? -1 : 1;
    $exp = ($exp & 0x7fff) - 16383 - 63; # (-63 to fractionalize significand)
    return $sign * $sig * 2 ** $exp;
}

#------------------------------------------------------------------------------
# Dump data in hex and ASCII to console
# Inputs: 0) data reference, 1) length or undef, 2-N) Options:
# Options: Start => offset to start of data (default=0)
#          Addr => address to print for data start (default=DataPos+Base+Start)
#          DataPos => position of data within block (relative to Base)
#          Base => base offset for pointers from start of file
#          Width => width of printout (bytes, default=16)
#          Prefix => prefix to print at start of line (default='')
#          MaxLen => maximum length to dump
#          Out => output file reference
#          Len => data length
sub HexDump($;$%)
{
    my $dataPt = shift;
    my $len    = shift;
    my %opts   = @_;
    my $start  = $opts{Start}  || 0;
    my $addr   = $opts{Addr};
    my $wid    = $opts{Width}  || 16;
    my $prefix = $opts{Prefix} || '';
    my $out    = $opts{Out}    || \*STDOUT;
    my $maxLen = $opts{MaxLen};
    my $datLen = length($$dataPt) - $start;
    my $more;
    $len = $opts{Len} if defined $opts{Len};

    $addr = $start + ($opts{DataPos} || 0) + ($opts{Base} || 0) unless defined $addr;
    $len = $datLen unless defined $len;
    if ($maxLen and $len > $maxLen) {
        # print one line less to allow for $more line below
        $maxLen = int(($maxLen - 1) / $wid) * $wid;
        $more = $len - $maxLen;
        $len = $maxLen;
    }
    if ($len > $datLen) {
        print $out "$prefix    Warning: Attempted dump outside data\n";
        print $out "$prefix    ($len bytes specified, but only $datLen available)\n";
        $len = $datLen;
    }
    my $format = sprintf("%%-%ds", $wid * 3);
    my $tmpl = 'H2' x $wid; # ('(H2)*' would have been nice, but older perl versions don't support it)
    my $i;
    for ($i=0; $i<$len; $i+=$wid) {
        $wid > $len-$i and $wid = $len-$i, $tmpl = 'H2' x $wid;
        printf $out "$prefix%8.4x: ", $addr+$i;
        my $dat = substr($$dataPt, $i+$start, $wid);
        my $s = join(' ', unpack($tmpl, $dat));
        printf $out $format, $s;
        $dat =~ tr /\x00-\x1f\x7f-\xff/./;
        print $out "[$dat]\n";
    }
    $more and print $out "$prefix    [snip $more bytes]\n";
}

#------------------------------------------------------------------------------
# Print verbose tag information
# Inputs: 0) ExifTool object reference, 1) tag ID
#         2) tag info reference (or undef)
#         3-N) extra parms:
# Parms: Index => Index of tag in menu (starting at 0)
#        Value => Tag value
#        DataPt => reference to value data block
#        DataPos => location of data block in file
#        Base => base added to all offsets
#        Size => length of value data within block
#        Format => value format string
#        Count => number of values
#        Extra => Extra Verbose=2 information to put after tag number
#        Table => Reference to tag table
#        --> plus any of these HexDump() options: Start, Addr, Width
sub VerboseInfo($$$%)
{
    my ($self, $tagID, $tagInfo, %parms) = @_;
    my $verbose = $$self{OPTIONS}{Verbose};
    my $out = $$self{OPTIONS}{TextOut};
    my ($tag, $line, $hexID);

    # generate hex number if tagID is numerical
    if (defined $tagID) {
        $tagID =~ /^\d+$/ and $hexID = sprintf("0x%.4x", $tagID);
    } else {
        $tagID = 'Unknown';
    }
    # get tag name
    if ($tagInfo and $$tagInfo{Name}) {
        $tag = $$tagInfo{Name};
    } else {
        my $prefix;
        $prefix = $parms{Table}{TAG_PREFIX} if $parms{Table};
        if ($prefix or $hexID) {
            $prefix = 'Unknown' unless $prefix;
            $tag = $prefix . '_' . ($hexID ? $hexID : $tagID);
        } else {
            $tag = $tagID;
        }
    }
    my $dataPt = $parms{DataPt};
    my $size = $parms{Size};
    $size = length $$dataPt unless defined $size or not $dataPt;
    my $indent = $$self{INDENT};

    # Level 1: print tag/value information
    $line = $indent;
    my $index = $parms{Index};
    if (defined $index) {
        $line .= $index . ') ';
        $line .= ' ' if length($index) < 2;
        $indent .= '    '; # indent everything else to align with tag name
    }
    $line .= $tag;
    if ($tagInfo and $$tagInfo{SubDirectory}) {
        $line .= ' (SubDirectory) -->';
    } else {
        my $maxLen = 90 - length($line);
        if (defined $parms{Value}) {
            $line .= ' = ' . $self->Printable($parms{Value}, $maxLen);
        } elsif ($dataPt) {
            my $start = $parms{Start} || 0;
            $line .= ' = ' . $self->Printable(substr($$dataPt,$start,$size), $maxLen);
        }
    }
    print $out "$line\n";

    # Level 2: print detailed information about the tag
    if ($verbose > 1 and ($parms{Extra} or $parms{Format} or
        $parms{DataPt} or defined $size or $tagID =~ /\//))
    {
        $line = $indent . '- Tag ';
        if ($hexID) {
            $line .= $hexID;
        } else {
            $tagID =~ s/([\0-\x1f\x7f-\xff])/sprintf('\\x%.2x',ord $1)/ge;
            $line .= "'$tagID'";
        }
        $line .= $parms{Extra} if defined $parms{Extra};
        my $format = $parms{Format};
        if ($format or defined $size) {
            $line .= ' (';
            if (defined $size) {
                $line .= "$size bytes";
                $line .= ', ' if $format;
            }
            if ($format) {
                $line .= $format;
                $line .= '['.$parms{Count}.']' if $parms{Count};
            }
            $line .= ')';
        }
        $line .= ':' if $verbose > 2 and $parms{DataPt};
        print $out "$line\n";
    }

    # Level 3: do hex dump of value
    if ($verbose > 2 and $parms{DataPt}) {
        $parms{Out} = $out;
        $parms{Prefix} = $indent;
        # limit dump length if Verbose < 5
        $parms{MaxLen} = $verbose == 3 ? 96 : 2048 if $verbose < 5;
        HexDump($dataPt, $size, %parms);
    }
}

#------------------------------------------------------------------------------
# Dump trailer information
# Inputs: 0) ExifTool object ref, 1) dirInfo hash (RAF, DirName, DataPos, DirLen)
# Notes: Restores current file position before returning
sub DumpTrailer($$)
{
    my ($self, $dirInfo) = @_;
    my $raf = $$dirInfo{RAF};
    my $curPos = $raf->Tell();
    my $trailer = $$dirInfo{DirName} || 'Unknown';
    my $pos = $$dirInfo{DataPos};
    my $verbose = $$self{OPTIONS}{Verbose};
    my $htmlDump = $$self{HTML_DUMP};
    my ($buff, $buf2);
    my $size = $$dirInfo{DirLen};
    $pos = $curPos unless defined $pos;

    # get full trailer size if not specified
    for (;;) {
        unless ($size) {
            $raf->Seek(0, 2) or last;
            $size = $raf->Tell() - $pos;
            last unless $size;
        }
        $raf->Seek($pos, 0) or last;
        if ($htmlDump) {
            my $num = $raf->Read($buff, $size) or return;
            my $desc = "$trailer trailer";
            $desc = "[$desc]" if $trailer eq 'Unknown';
            $self->HDump($pos, $num, $desc, undef, 0x08);
            last;
        }
        my $out = $$self{OPTIONS}{TextOut};
        printf $out "$trailer trailer (%d bytes at offset 0x%.4x):\n", $size, $pos;
        last unless $verbose > 2;
        my $num = $size;    # number of bytes to read
        # limit size if not very verbose
        if ($verbose < 5) {
            my $limit = $verbose < 4 ? 96 : 512;
            $num = $limit if $num > $limit;
        }
        $raf->Read($buff, $num) == $num or return;
        # read the end of the trailer too if not done already
        if ($size > 2 * $num) {
            $raf->Seek($pos + $size - $num, 0);
            $raf->Read($buf2, $num);
        } elsif ($size > $num) {
            $raf->Seek($pos + $num, 0);
            $raf->Read($buf2, $size - $num);
            $buff .= $buf2;
            undef $buf2;
        }
        HexDump(\$buff, undef, Addr => $pos, Out => $out);
        if (defined $buf2) {
            print $out "    [snip ", $size - $num * 2, " bytes]\n";
            HexDump(\$buf2, undef, Addr => $pos + $size - $num, Out => $out);
        }
        last;
    }
    $raf->Seek($curPos, 0);
}

#------------------------------------------------------------------------------
# Dump unknown trailer information
# Inputs: 0) ExifTool ref, 1) dirInfo ref (with RAF, DataPos and DirLen defined)
# Notes: changes dirInfo elements
sub DumpUnknownTrailer($$)
{
    my ($self, $dirInfo) = @_;
    my $pos = $$dirInfo{DataPos};
    my $endPos = $pos + $$dirInfo{DirLen};
    # account for preview/MPF image trailer
    my $prePos = $$self{VALUE}{PreviewImageStart} || $$self{PreviewImageStart};
    my $preLen = $$self{VALUE}{PreviewImageLength} || $$self{PreviewImageLength};
    my $tag = 'PreviewImage';
    my $mpImageNum = 0;
    my (%image, $lastOne);
    for (;;) {
        # add to Preview block list if valid and in the trailer
        $image{$prePos} = [$tag, $preLen] if $prePos and $preLen and $prePos+$preLen > $pos;
        last if $lastOne;   # checked all images
        # look for MPF images (in the the proper order)
        ++$mpImageNum;
        $prePos = $$self{VALUE}{"MPImageStart ($mpImageNum)"};
        if (defined $prePos) {
            $preLen = $$self{VALUE}{"MPImageLength ($mpImageNum)"};
        } else {
            $prePos = $$self{VALUE}{'MPImageStart'};
            $preLen = $$self{VALUE}{'MPImageLength'};
            $lastOne = 1;
        }
        $tag = "MPImage$mpImageNum";
    }
    # dump trailer sections in order
    $image{$endPos} = [ '', 0 ];    # add terminator "image"
    foreach $prePos (sort { $a <=> $b } keys %image) {
        if ($pos < $prePos) {
            # dump unknown trailer data
            $$dirInfo{DirName} = 'Unknown';
            $$dirInfo{DataPos} = $pos;
            $$dirInfo{DirLen} = $prePos - $pos;
            $self->DumpTrailer($dirInfo);
        }
        ($tag, $preLen) = @{$image{$prePos}};
        last unless $preLen;
        # dump image if verbose (it is htmlDump'd by ExtractImage)
        if ($$self{OPTIONS}{Verbose}) {
            $$dirInfo{DirName} = $tag;
            $$dirInfo{DataPos} = $prePos;
            $$dirInfo{DirLen}  = $preLen;
            $self->DumpTrailer($dirInfo);
        }
        $pos = $prePos + $preLen;
    }
}

#------------------------------------------------------------------------------
# Find last element in linked list
# Inputs: 0) element in list
# Returns: Last element in list
sub LastInList($)
{
    my $element = shift;
    while ($$element{Next}) {
        $element = $$element{Next};
    }
    return $element;
}

#------------------------------------------------------------------------------
# Print verbose directory information
# Inputs: 0) ExifTool object reference, 1) directory name or dirInfo ref
#         2) number of entries in directory (or 0 if unknown)
#         3) optional size of directory in bytes
sub VerboseDir($$;$$)
{
    my ($self, $name, $entries, $size) = @_;
    return unless $$self{OPTIONS}{Verbose};
    if (ref $name eq 'HASH') {
        $size = $$name{DirLen} unless $size;
        $name = $$name{Name} || $$name{DirName};
    }
    my $indent = substr($$self{INDENT}, 0, -2);
    my $out = $$self{OPTIONS}{TextOut};
    my $str = $entries ? " with $entries entries" : '';
    $str .= ", $size bytes" if $size;
    print $out "$indent+ [$name directory$str]\n";
}

#------------------------------------------------------------------------------
# Print verbose value while writing
# Inputs: 0) ExifTool object ref, 1) heading "eg. '+ IPTC:Keywords',
#         2) value, 3) [optional] extra text after value
sub VerboseValue($$$;$)
{
    return unless $_[0]{OPTIONS}{Verbose} > 1;
    my ($self, $str, $val, $xtra) = @_;
    my $out = $$self{OPTIONS}{TextOut};
    $xtra or $xtra = '';
    my $maxLen = 81 - length($str) - length($xtra);
    $val = $self->Printable($val, $maxLen);
    print $out "    $str = '$val'$xtra\n";
}

#------------------------------------------------------------------------------
# Pack Unicode numbers into UTF8 string
# Inputs: 0-N) list of Unicode numbers
# Returns: Packed UTF-8 string
sub PackUTF8(@)
{
    my @out;
    while (@_) {
        my $ch = pop;
        unshift(@out, $ch), next if $ch < 0x80;
        unshift(@out, 0x80 | ($ch & 0x3f));
        $ch >>= 6;
        unshift(@out, 0xc0 | $ch), next if $ch < 0x20;
        unshift(@out, 0x80 | ($ch & 0x3f));
        $ch >>= 6;
        unshift(@out, 0xe0 | $ch), next if $ch < 0x10;
        unshift(@out, 0x80 | ($ch & 0x3f));
        $ch >>= 6;
        unshift(@out, 0xf0 | ($ch & 0x07));
    }
    return pack('C*', @out);
}

#------------------------------------------------------------------------------
# Unpack numbers from UTF8 string
# Inputs: 0) UTF-8 string
# Returns: List of Unicode numbers (sets $evalWarning on error)
sub UnpackUTF8($)
{
    my (@out, $pos);
    pos($_[0]) = $pos = 0;  # start at beginning of string
    for (;;) {
        my ($ch, $newPos, $val, $byte);
        if ($_[0] =~ /([\x80-\xff])/g) {
            $ch = ord($1);
            $newPos = pos($_[0]) - 1;
        } else {
            $newPos = length $_[0];
        }
        # unpack 7-bit characters
        my $len = $newPos - $pos;
        push @out, unpack("x${pos}C$len",$_[0]) if $len;
        last unless defined $ch;
        $pos = $newPos + 1;
        # minimum lead byte for 2-byte sequence is 0xc2 (overlong sequences
        # not allowed), 0xf8-0xfd are restricted by RFC 3629 (no 5 or 6 byte
        # sequences), and 0xfe and 0xff are not valid in UTF-8 strings
        if ($ch < 0xc2 or $ch >= 0xf8) {
            push @out, ord('?');    # invalid UTF-8
            $evalWarning = 'Bad UTF-8';
            next;
        }
        # decode 2, 3 and 4-byte sequences
        my $n = 1;
        if ($ch < 0xe0) {
            $val = $ch & 0x1f;      # 2-byte sequence
        } elsif ($ch < 0xf0) {
            $val = $ch & 0x0f;      # 3-byte sequence
            ++$n;
        } else {
            $val = $ch & 0x07;      # 4-byte sequence
            $n += 2;
        }
        unless ($_[0] =~ /\G([\x80-\xbf]{$n})/g) {
            pos($_[0]) = $pos;      # restore position
            push @out, ord('?');    # invalid UTF-8
            $evalWarning = 'Bad UTF-8';
            next;
        }
        foreach $byte (unpack 'C*', $1) {
            $val = ($val << 6) | ($byte & 0x3f);
        }
        push @out, $val;    # save Unicode character value
        $pos += $n;         # position at end of UTF-8 character
    }
    return @out;
}

#------------------------------------------------------------------------------
# Return current time in EXIF format
# Inputs: 0) flag to include timezone (0 to disable, undef or 1 to include)
# Returns: time string
sub TimeNow(;$)
{
    my $tzFlag = shift;
    my $time = time();
    my @tm = localtime $time;
    my $tz = ($tzFlag or not defined $tzFlag) ? TimeZoneString(\@tm, $time) : '';
    return sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d%s",
                   $tm[5]+1900, $tm[4]+1, $tm[3],
                   $tm[2], $tm[1], $tm[0], $tz);
}

#------------------------------------------------------------------------------
# Generate a new, random GUID
# Inputs: <none>
# Returns: GUID string
my $guidCount;
sub NewGUID()
{
    my @tm = localtime time;
    $guidCount = 0 unless defined $guidCount and ++$guidCount < 0x100;
    return sprintf('%.4d%.2d%.2d%.2d%.2d%.2d%.2X%.4X%.4X%.4X%.4X',
                   $tm[5]+1900, $tm[4]+1, $tm[3], $tm[2], $tm[1], $tm[0], $guidCount,
                   $$ & 0xffff, rand(0x10000), rand(0x10000), rand(0x10000));
}

#------------------------------------------------------------------------------
# Inverse date/time print conversion (reformat to YYYY:mm:dd HH:MM:SS[.ss][+-HH:MM|Z])
# Inputs: 0) ExifTool object ref, 1) Date/Time string, 2) timezone flag:
#               0     - remove timezone and sub-seconds if they exist
#               1     - add timezone if it doesn't exist
#               undef - leave timezone alone
#         3) flag to allow date-only (YYYY, YYYY:mm or YYYY:mm:dd) or time without seconds
# Returns: formatted date/time string (or undef and issues warning on error)
# Notes: currently accepts different separators, but doesn't use DateFormat yet
sub InverseDateTime($$;$$)
{
    my ($self, $val, $tzFlag, $dateOnly) = @_;
    my ($rtnVal, $tz);
    # strip off timezone first if it exists
    if ($val =~ s/([+-])(\d{1,2}):?(\d{2})\s*$//i) {
        $tz = sprintf("$1%.2d:$3", $2);
    } elsif ($val =~ s/Z$//i) {
        $tz = 'Z';
    } else {
        $tz = '';
        # allow special value of 'now'
        return TimeNow($tzFlag) if lc($val) eq 'now';
    }
    if ($val =~ /(\d{4})/g) {           # get YYYY
        my $yr = $1;
        my @a = ($val =~ /\d{1,2}/g);   # get mm, dd, HH, and maybe MM, SS
        length($_) < 2 and $_ = "0$_" foreach @a;   # pad to 2 digits if necessary
        if (@a >= 3) {
            my $ss = $a[4];             # get SS
            push @a, '00' while @a < 5; # add MM, SS if not given
            # get sub-seconds if they exist (must be after SS, and have leading ".")
            my $fs = (@a > 5 and $val =~ /(\.\d+)\s*$/) ? $1 : '';
            # add/remove timezone if necessary
            if ($tzFlag) {
                if (not $tz) {
                    if (eval { require Time::Local }) {
                        # determine timezone offset for this time
                        my @args = ($a[4],$a[3],$a[2],$a[1],$a[0]-1,$yr-1900);
                        my $diff = Time::Local::timegm(@args) - TimeLocal(@args);
                        $tz = TimeZoneString($diff / 60);
                    } else {
                        $tz = 'Z';  # don't know time zone
                    }
                }
            } elsif (defined $tzFlag) {
                $tz = $fs = ''; # remove timezone and sub-seconds
            }
            if (defined $ss) {
                $ss = ":$ss";
            } elsif ($dateOnly) {
                $ss = '';
            } else {
                $ss = ':00';
            }
            # construct properly formatted date/time string
            $rtnVal = "$yr:$a[0]:$a[1] $a[2]:$a[3]$ss$fs$tz";
        } elsif ($dateOnly) {
            $rtnVal = join ':', $yr, @a;
        }
    }
    $rtnVal or warn "Invalid date/time (use YYYY:mm:dd HH:MM:SS[.ss][+/-HH:MM|Z])\n";
    return $rtnVal;
}

#------------------------------------------------------------------------------
# Set byte order according to our current preferences
# Inputs: 0) ExifTool object ref
# Returns: new byte order ('II' or 'MM') and sets current byte order
# Notes: takes the first of the following that is valid:
#  1) ByteOrder option
#  2) new value for ExifByteOrder
#  3) makenote byte order from last file read
#  4) big endian
sub SetPreferredByteOrder($)
{
    my $self = shift;
    my $byteOrder = $self->Options('ByteOrder') ||
                    $self->GetNewValue('ExifByteOrder') ||
                    $$self{MAKER_NOTE_BYTE_ORDER} || 'MM';
    unless (SetByteOrder($byteOrder)) {
        warn "Invalid byte order '$byteOrder'\n" if $self->Options('Verbose');
        $byteOrder = $$self{MAKER_NOTE_BYTE_ORDER} || 'MM';
        SetByteOrder($byteOrder);
    }
    return GetByteOrder();
}

#------------------------------------------------------------------------------
# Assemble a continuing fraction into a rational value
# Inputs: 0) numerator, 1) denominator
#         2-N) list of fraction denominators, deepest first
# Returns: numerator, denominator (in list context)
sub AssembleRational($$@)
{
    @_ < 3 and return @_;
    my ($num, $denom, $frac) = splice(@_, 0, 3);
    return AssembleRational($frac*$num+$denom, $num, @_);
}

#------------------------------------------------------------------------------
# Convert a floating point number (or 'inf' or 'undef' or a fraction) into a rational
# Inputs: 0) floating point number, 1) optional maximum value (defaults to 0x7fffffff)
# Returns: numerator, denominator (in list context)
# Notes:
# - the returned rational will be accurate to at least 8 significant figures if possible
# - eg. an input of 3.14159265358979 returns a rational of 104348/33215,
#   which equals    3.14159265392142 and is accurate to 10 significant figures
# - these routines were a bit tricky, but fun to write!
sub Rationalize($;$)
{
    my $val = shift;
    return (1, 0) if $val eq 'inf';
    return (0, 0) if $val eq 'undef';
    return ($1,$2) if $val =~ m{^([-+]?\d+)/(\d+)$}; # accept fractional values
    # Note: Just testing "if $val" doesn't work because '0.0' is true!  (ugghh!)
    return (0, 1) if $val == 0;
    my $sign = $val < 0 ? ($val = -$val, -1) : 1;
    my ($num, $denom, @fracs);
    my $frac = $val;
    my $maxInt = shift || 0x7fffffff;
    for (;;) {
        my ($n, $d) = AssembleRational(int($frac + 0.5), 1, @fracs);
        if ($n > $maxInt or $d > $maxInt) {
            last if defined $num;
            return ($sign, $maxInt) if $val < 1;
            return ($sign * $maxInt, 1);
        }
        ($num, $denom) = ($n, $d);      # save last good values
        my $err = ($n/$d-$val) / $val;  # get error of this rational
        last if abs($err) < 1e-8;       # all done if error is small
        my $int = int($frac);
        unshift @fracs, $int;
        last unless $frac -= $int;
        $frac = 1 / $frac;
    }
    return ($num * $sign, $denom);
}

#------------------------------------------------------------------------------
# Utility routines to for writing binary data values
# Inputs: 0) value, 1) data ref, 2) offset
# Notes: prototype is (@) so values can be passed from list if desired
sub Set16s(@)
{
    my $val = shift;
    $val < 0 and $val += 0x10000;
    return Set16u($val, @_);
}
sub Set32s(@)
{
    my $val = shift;
    $val < 0 and $val += 0xffffffff, ++$val;
    return Set32u($val, @_);
}
sub Set64u(@)
{
    my $val = shift;
    my $hi = int($val / 4294967296);
    my $lo = Set32u($val - $hi * 4294967296);
    $hi = Set32u($hi);
    $val = GetByteOrder() eq 'MM' ? $hi . $lo : $lo . $hi;
    $_[1] and substr(${$_[1]}, $_[2], length($val)) = $val;
    return $val;
}
sub SetRational64u(@) {
    my ($numer,$denom) = Rationalize($_[0],0xffffffff);
    my $val = Set32u($numer) . Set32u($denom);
    $_[1] and substr(${$_[1]}, $_[2], length($val)) = $val;
    return $val;
}
sub SetRational64s(@) {
    my ($numer,$denom) = Rationalize($_[0]);
    my $val = Set32s($numer) . Set32u($denom);
    $_[1] and substr(${$_[1]}, $_[2], length($val)) = $val;
    return $val;
}
sub SetRational32u(@) {
    my ($numer,$denom) = Rationalize($_[0],0xffff);
    my $val = Set16u($numer) . Set16u($denom);
    $_[1] and substr(${$_[1]}, $_[2], length($val)) = $val;
    return $val;
}
sub SetRational32s(@) {
    my ($numer,$denom) = Rationalize($_[0],0x7fff);
    my $val = Set16s($numer) . Set16u($denom);
    $_[1] and substr(${$_[1]}, $_[2], length($val)) = $val;
    return $val;
}
sub SetFixed16u(@) {
    my $val = int(shift() * 0x100 + 0.5);
    return Set16u($val, @_);
}
sub SetFixed16s(@) {
    my $val = shift;
    return Set16s(int($val * 0x100 + ($val < 0 ? -0.5 : 0.5)), @_);
}
sub SetFixed32u(@) {
    my $val = int(shift() * 0x10000 + 0.5);
    return Set32u($val, @_);
}
sub SetFixed32s(@) {
    my $val = shift;
    return Set32s(int($val * 0x10000 + ($val < 0 ? -0.5 : 0.5)), @_);
}
sub SetFloat(@) {
    my $val = SwapBytes(pack('f',$_[0]), 4);
    $_[1] and substr(${$_[1]}, $_[2], length($val)) = $val;
    return $val;
}
sub SetDouble(@) {
    # swap 32-bit words (ARM quirk) and bytes if necessary
    my $val = SwapBytes(SwapWords(pack('d',$_[0])), 8);
    $_[1] and substr(${$_[1]}, $_[2], length($val)) = $val;
    return $val;
}
#------------------------------------------------------------------------------
# hash lookups for writing binary data values
my %writeValueProc = (
    int8s => \&Set8s,
    int8u => \&Set8u,
    int16s => \&Set16s,
    int16u => \&Set16u,
    int16uRev => \&Set16uRev,
    int32s => \&Set32s,
    int32u => \&Set32u,
    int64u => \&Set64u,
    rational32s => \&SetRational32s,
    rational32u => \&SetRational32u,
    rational64s => \&SetRational64s,
    rational64u => \&SetRational64u,
    fixed16u => \&SetFixed16u,
    fixed16s => \&SetFixed16s,
    fixed32u => \&SetFixed32u,
    fixed32s => \&SetFixed32s,
    float => \&SetFloat,
    double => \&SetDouble,
    ifd => \&Set32u,
);
# verify that we can write floats on this platform
{
    my %writeTest = (
        float =>  [ -3.14159, 'c0490fd0' ],
        double => [ -3.14159, 'c00921f9f01b866e' ],
    );
    my $format;
    my $oldOrder = GetByteOrder();
    SetByteOrder('MM');
    foreach $format (keys %writeTest) {
        my ($val, $hex) = @{$writeTest{$format}};
        # add floating point entries if we can write them
        next if unpack('H*', &{$writeValueProc{$format}}($val)) eq $hex;
        delete $writeValueProc{$format};    # we can't write them
    }
    SetByteOrder($oldOrder);
}

#------------------------------------------------------------------------------
# write binary data value (with current byte ordering)
# Inputs: 0) value, 1) format string
#         2) number of values:
#               undef = 1 for numerical types, or data length for string/undef types
#                  -1 = number of space-delimited values in the input string
#         3) optional data reference, 4) value offset (may be negative for bytes from end)
# Returns: packed value (and sets value in data) or undef on error
# Notes: May modify input value to round for integer formats
sub WriteValue($$;$$$$)
{
    my ($val, $format, $count, $dataPt, $offset) = @_;
    my $proc = $writeValueProc{$format};
    my $packed;

    if ($proc) {
        my @vals = split(' ',$val);
        if ($count) {
            $count = @vals if $count < 0;
        } else {
            $count = 1;   # assume 1 if count not specified
        }
        $packed = '';
        while ($count--) {
            $val = shift @vals;
            return undef unless defined $val;
            # validate numerical formats
            if ($format =~ /^int/) {
                unless (IsInt($val) or IsHex($val)) {
                    return undef unless IsFloat($val);
                    # round to nearest integer
                    $val = int($val + ($val < 0 ? -0.5 : 0.5));
                    $_[0] = $val;
                }
            } elsif (not IsFloat($val)) {
                return undef unless $format =~ /^rational/ and ($val eq 'inf' or
                    $val eq 'undef' or IsRational($val));
            }
            $packed .= &$proc($val);
        }
    } elsif ($format eq 'string' or $format eq 'undef') {
        $format eq 'string' and $val .= "\0";   # null-terminate strings
        if ($count and $count > 0) {
            my $diff = $count - length($val);
            if ($diff) {
                #warn "wrong string length!\n";
                # adjust length of string to match specified count
                if ($diff < 0) {
                    if ($format eq 'string') {
                        return undef unless $count;
                        $val = substr($val, 0, $count - 1) . "\0";
                    } else {
                        $val = substr($val, 0, $count);
                    }
                } else {
                    $val .= "\0" x $diff;
                }
            }
        } else {
            $count = length($val);
        }
        $dataPt and substr($$dataPt, $offset, $count) = $val;
        return $val;
    } else {
        warn "Sorry, Can't write $format values on this platform\n";
        return undef;
    }
    $dataPt and substr($$dataPt, $offset, length($packed)) = $packed;
    return $packed;
}

#------------------------------------------------------------------------------
# Encode bit mask (the inverse of DecodeBits())
# Inputs: 0) value to encode, 1) Reference to hash for encoding (or undef)
#         2) optional number of bits per word (defaults to 32), 3) total bits
# Returns: bit mask or undef on error (plus error string in list context)
sub EncodeBits($$;$$)
{
    my ($val, $lookup, $bits, $num) = @_;
    $bits or $bits = 32;
    $num or $num = $bits;
    my $words = int(($num + $bits - 1) / $bits);
    my @outVal = (0) x $words;
    if ($val ne '(none)') {
        my @vals = split /\s*,\s*/, $val;
        foreach $val (@vals) {
            my $bit;
            if ($lookup) {
                $bit = ReverseLookup($val, $lookup);
                # (Note: may get non-numerical $bit values from Unknown() tags)
                unless (defined $bit) {
                    if ($val =~ /\[(\d+)\]/) { # numerical bit specification
                        $bit = $1;
                    } else {
                        # don't return error string unless more than one value
                        return undef unless @vals > 1 and wantarray;
                        return (undef, "no match for '$val'");
                    }
                }
            } else {
                $bit = $val;
            }
            unless (IsInt($bit) and $bit < $num) {
                return undef unless wantarray;
                return (undef, IsInt($bit) ? 'bit number too high' : 'not an integer');
            }
            my $word = int($bit / $bits);
            $outVal[$word] |= (1 << ($bit - $word * $bits));
        }
    }
    return "@outVal";
}

#------------------------------------------------------------------------------
# get current position in output file (or end of file if a scalar reference)
# Inputs: 0) file or scalar reference
# Returns: Current position or -1 on error
sub Tell($)
{
    my $outfile = shift;
    if (UNIVERSAL::isa($outfile,'GLOB')) {
        return tell($outfile);
    } else {
        return length($$outfile);
    }
}

#------------------------------------------------------------------------------
# write to file or memory
# Inputs: 0) file or scalar reference, 1-N) list of stuff to write
# Returns: true on success
sub Write($@)
{
    my $outfile = shift;
    if (UNIVERSAL::isa($outfile,'GLOB')) {
        return print $outfile @_;
    } elsif (ref $outfile eq 'SCALAR') {
        $$outfile .= join('', @_);
        return 1;
    }
    return 0;
}

#------------------------------------------------------------------------------
# Write trailer buffer to file (applying fixups if necessary)
# Inputs: 0) ExifTool object ref, 1) trailer dirInfo ref, 2) output file ref
# Returns: 1 on success
sub WriteTrailerBuffer($$$)
{
    my ($self, $trailInfo, $outfile) = @_;
    if ($$self{DEL_GROUP}{Trailer}) {
        $self->VPrint(0, "  Deleting trailer ($$trailInfo{Offset} bytes)\n");
        ++$$self{CHANGED};
        return 1;
    }
    my $pos = Tell($outfile);
    my $trailPt = $$trailInfo{OutFile};
    # apply fixup if necessary (AFCP requires this)
    if ($$trailInfo{Fixup}) {
        if ($pos > 0) {
            # shift offsets to final AFCP location and write it out
            $$trailInfo{Fixup}{Shift} += $pos;
            $$trailInfo{Fixup}->ApplyFixup($trailPt);
        } else {
            $self->Error("Can't get file position for trailer offset fixup",1);
        }
    }
    return Write($outfile, $$trailPt);
}

#------------------------------------------------------------------------------
# Add trailers as a block
# Inputs: 0) ExifTool object ref, 1) [optional] trailer data raf,
#         1 or 2-N) trailer types to add (or none to add all)
# Returns: new trailer ref, or undef
# - increments CHANGED if trailer was added
sub AddNewTrailers($;@)
{
    my ($self, @types) = @_;
    my $trailPt;
    ref $types[0] and $trailPt = shift @types;
    $types[0] or shift @types; # (in case undef data ref is passed)
    # add all possible trailers if none specified (currently only CanonVRD)
    @types or @types = qw(CanonVRD CanonDR4);
    # add trailers as a block (if not done already)
    my $type;
    foreach $type (@types) {
        next unless $$self{NEW_VALUE}{$Image::ExifTool::Extra{$type}};
        next if $$self{"Did$type"};
        my $val = $self->GetNewValue($type) or next;
        # DR4 record must be wrapped in VRD trailer package
        if ($type eq 'CanonDR4') {
            next if $$self{DidCanonVRD};    # (only allow one VRD trailer)
            require Image::ExifTool::CanonVRD;
            $val = Image::ExifTool::CanonVRD::WrapDR4($val);
            $$self{DidCanonVRD} = 1;
        }
        my $verb = $trailPt ? 'Writing' : 'Adding';
        $self->VPrint(0, "  $verb $type as a block\n");
        if ($trailPt) {
            $$trailPt .= $val;
        } else {
            $trailPt = \$val;
        }
        $$self{"Did$type"} = 1;
        ++$$self{CHANGED};
    }
    return $trailPt;
}

#------------------------------------------------------------------------------
# Write segment, splitting up into multiple segments if necessary
# Inputs: 0) file or scalar reference, 1) segment marker
#         2) segment header, 3) segment data ref, 4) segment type
# Returns: number of segments written, or 0 on error
sub WriteMultiSegment($$$$;$)
{
    my ($outfile, $marker, $header, $dataPt, $type) = @_;
    $type or $type = '';
    my $len = length($$dataPt);
    my $hdr = "\xff" . chr($marker);
    my $count = 0;
    my $maxLen = $maxSegmentLen - length($header);
    $maxLen -= 2 if $type eq 'ICC'; # leave room for segment counters
    my $num = int(($len + $maxLen - 1) / $maxLen);  # number of segments to write
    my $n;
    # write data, splitting into multiple segments if necessary
    # (each segment gets its own header)
    for ($n=0; $n<$len; $n+=$maxLen) {
        ++$count;
        my $size = $len - $n;
        $size > $maxLen and $size = $maxLen;
        my $buff = substr($$dataPt,$n,$size);
        $size += length($header);
        if ($type eq 'ICC') {
            $buff = pack('CC', $count, $num) . $buff;
            $size += 2;
        }
        # write the new segment with appropriate header
        my $segHdr = $hdr . pack('n', $size + 2);
        Write($outfile, $segHdr, $header, $buff) or return 0;
    }
    return $count;
}

#------------------------------------------------------------------------------
# Write XMP segment(s) to JPEG file
# Inputs: 0) ExifTool object ref, 1) outfile ref, 2) XMP data ref,
#         3) extended XMP data ref, 4) 32-char extended XMP GUID (or undef if no extended data)
# Returns: true on success, false on write error
sub WriteMultiXMP($$$$$)
{
    my ($self, $outfile, $dataPt, $extPt, $guid) = @_;
    my $success = 1;

    # write main XMP segment
    my $size = length($$dataPt) + length($xmpAPP1hdr);
    if ($size > $maxXMPLen) {
        $self->Error("XMP block too large for JPEG segment! ($size bytes)", 1);
        return 1;
    }
    my $app1hdr = "\xff\xe1" . pack('n', $size + 2);
    Write($outfile, $app1hdr, $xmpAPP1hdr, $$dataPt) or $success = 0;
    # write extended XMP segment(s) if necessary
    if (defined $guid) {
        $size = length($$extPt);
        my $maxLen = $maxXMPLen - 75; # maximum size without 75-byte header
        my $off;
        for ($off=0; $off<$size; $off+=$maxLen) {
            # header(75) = signature(35) + guid(32) + size(4) + offset(4)
            my $len = $size - $off;
            $len = $maxLen if $len > $maxLen;
            $app1hdr = "\xff\xe1" . pack('n', $len + 75 + 2);
            $self->VPrint(0, "Writing extended XMP segment ($len bytes)\n");
            Write($outfile, $app1hdr, $xmpExtAPP1hdr, $guid, pack('N2', $size, $off),
                  substr($$extPt, $off, $len)) or $success = 0;
        }
    }
    return $success;
}

#------------------------------------------------------------------------------
# WriteJPEG : Write JPEG image
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid JPEG file, or -1 if
#          an output file was specified and a write error occurred
sub WriteJPEG($$)
{
    my ($self, $dirInfo) = @_;
    my $outfile = $$dirInfo{OutFile};
    my $raf = $$dirInfo{RAF};
    my ($ch, $s, $length,$err, %doneDir, $isEXV, $creatingEXV);
    my $verbose = $$self{OPTIONS}{Verbose};
    my $out = $$self{OPTIONS}{TextOut};
    my $rtnVal = 0;
    my %dumpParms = ( Out => $out );
    my ($writeBuffer, $oldOutfile); # used to buffer writing until PreviewImage position is known

    # check to be sure this is a valid JPG or EXV file
    unless ($raf->Read($s,2) == 2 and $s eq "\xff\xd8") {
        if (defined $s and length $s) {
            return 0 unless $s eq "\xff\x01" and $raf->Read($s,5) == 5 and $s eq 'Exiv2';
        } else {
            return 0 unless $$self{FILE_TYPE} eq 'EXV';
            $s = 'Exiv2';
            $creatingEXV = 1;
        }
        Write($outfile,"\xff\x01") or $err = 1;
        $isEXV = 1;
    }
    $dumpParms{MaxLen} = 128 unless $verbose > 3;

    delete $$self{PREVIEW_INFO};   # reset preview information
    delete $$self{DEL_PREVIEW};    # reset flag to delete preview

    Write($outfile, $s) or $err = 1;
    # figure out what segments we need to write for the tags we have set
    my $addDirs = $$self{ADD_DIRS};
    my $editDirs = $$self{EDIT_DIRS};
    my $delGroup = $$self{DEL_GROUP};
    my $path = $$self{PATH};
    my $pn = scalar @$path;

    # set input record separator to 0xff (the JPEG marker) to make reading quicker
    local $/ = "\xff";
#
# pre-scan image to determine if any create-able segment already exists
#
    my $pos = $raf->Tell();
    my ($marker, @dirOrder, %dirCount);
    Prescan: for (;;) {
        # read up to next marker (JPEG markers begin with 0xff)
        $raf->ReadLine($s) or last;
        # JPEG markers can be padded with unlimited 0xff's
        for (;;) {
            $raf->Read($ch, 1) or last Prescan;
            $marker = ord($ch);
            last unless $marker == 0xff;
        }
        # SOS signifies end of meta information
        if ($marker == 0xda) {
            push(@dirOrder, 'SOS');
            $dirCount{SOS} = 1;
            last;
        }
        my $dirName;
        # handle SOF markers: SOF0-SOF15, except DHT(0xc4), JPGA(0xc8) and DAC(0xcc)
        if (($marker & 0xf0) == 0xc0 and ($marker == 0xc0 or $marker & 0x03)) {
            last unless $raf->Seek(7, 1);
        # read data for all markers except stand-alone
        # markers 0x00, 0x01 and 0xd0-0xd7 (NULL, TEM, RST0-RST7)
        } elsif ($marker!=0x00 and $marker!=0x01 and ($marker<0xd0 or $marker>0xd7)) {
            # read record length word
            last unless $raf->Read($s, 2) == 2;
            my $len = unpack('n',$s);   # get data length
            last unless defined($len) and $len >= 2;
            $len -= 2;  # subtract size of length word
            if (($marker & 0xf0) == 0xe0) {  # is this an APP segment?
                my $n = $len < 64 ? $len : 64;
                $raf->Read($s, $n) == $n or last;
                $len -= $n;
                # Note: only necessary to recognize APP segments that we can create,
                # or delete as a group (and the names below should match @delGroups)
                if ($marker == 0xe0) {
                    $s =~ /^JFIF\0/         and $dirName = 'JFIF';
                    $s =~ /^JFXX\0\x10/     and $dirName = 'JFXX';
                    $s =~ /^(II|MM).{4}HEAPJPGM/s and $dirName = 'CIFF';
                } elsif ($marker == 0xe1) {
                    $s =~ /^(.{0,4})$exifAPP1hdr/s and $dirName = 'IFD0';
                    $s =~ /^$xmpAPP1hdr/    and $dirName = 'XMP';
                    $s =~ /^$xmpExtAPP1hdr/ and $dirName = 'XMP';
                } elsif ($marker == 0xe2) {
                    $s =~ /^ICC_PROFILE\0/  and $dirName = 'ICC_Profile';
                    $s =~ /^FPXR\0/         and $dirName = 'FlashPix';
                    $s =~ /^MPF\0/          and $dirName = 'MPF';
                } elsif ($marker == 0xe3) {
                    $s =~ /^(Meta|META|Exif)\0\0/ and $dirName = 'Meta';
                } elsif ($marker == 0xe5) {
                    $s =~ /^RMETA\0/        and $dirName = 'RMETA';
                } elsif ($marker == 0xec) {
                    $s =~ /^Ducky/          and $dirName = 'Ducky';
                } elsif ($marker == 0xed) {
                    $s =~ /^$psAPP13hdr/    and $dirName = 'Photoshop';
                } elsif ($marker == 0xee) {
                    $s =~ /^Adobe/          and $dirName = 'Adobe';
                }
                # initialize doneDir as a flag that the directory exists
                # (unless we are deleting it anyway)
                $doneDir{$dirName} = 0 if defined $dirName and not $$delGroup{$dirName};
            }
            $raf->Seek($len, 1) or last;
        }
        $dirName or $dirName = JpegMarkerName($marker);
        $dirCount{$dirName} = ($dirCount{$dirName} || 0) + 1;
        push @dirOrder, $dirName;
    }
    unless ($marker and $marker == 0xda) {
        $isEXV or $self->Error('Corrupted JPEG image'), return 1;
        $marker and $marker ne 0xd9 and $self->Error('Corrupted EXV file'), return 1;
        push @dirOrder, 'EOI';
        $dirCount{EOI} = 1;
    }
    $raf->Seek($pos, 0) or $self->Error('Seek error'), return 1;
#
# re-write the image
#
    my ($combinedSegData, $segPos, %extendedXMP);
    my (@iccChunk, $iccChunkCount, $iccChunksTotal);
    # read through each segment in the JPEG file
    Marker: for (;;) {

        # read up to next marker (JPEG markers begin with 0xff)
        my $segJunk;
        $raf->ReadLine($segJunk) or $segJunk = '';
        # remove the 0xff but write the rest of the junk up to this point
        # (this will handle the data after the first 7 bytes of SOF segments)
        chomp($segJunk);
        Write($outfile, $segJunk) if length $segJunk;
        # JPEG markers can be padded with unlimited 0xff's
        for (;;) {
            if ($raf->Read($ch, 1)) {
                $marker = ord($ch);
                last unless $marker == 0xff;
            } elsif ($creatingEXV) {
                # create EXV from scratch
                $marker = 0xd9; # EOI
                last;
            } else {
                $self->Error('Format error');
                return 1;
            }
        }
        # read the segment data
        my $segData;
        # handle SOF markers: SOF0-SOF15, except DHT(0xc4), JPGA(0xc8) and DAC(0xcc)
        if (($marker & 0xf0) == 0xc0 and ($marker == 0xc0 or $marker & 0x03)) {
            last unless $raf->Read($segData, 7) == 7;
        # read data for all markers except stand-alone
        # markers 0x00, 0x01 and 0xd0-0xd7 (NULL, TEM, EOI, RST0-RST7)
        } elsif ($marker!=0x00 and $marker!=0x01 and $marker!=0xd9 and
            ($marker<0xd0 or $marker>0xd7))
        {
            # read record length word
            last unless $raf->Read($s, 2) == 2;
            my $len = unpack('n',$s);   # get data length
            last unless defined($len) and $len >= 2;
            $segPos = $raf->Tell();
            $len -= 2;  # subtract size of length word
            last unless $raf->Read($segData, $len) == $len;
        }
        # initialize variables for this segment
        my $hdr = "\xff" . chr($marker);    # segment header
        my $markerName = JpegMarkerName($marker);
        my $dirName = shift @dirOrder;      # get directory name
#
# create all segments that must come before this one
# (nothing comes before SOI or after SOS)
#
        while ($markerName ne 'SOI') {
            if (exists $$addDirs{JFIF} and not defined $doneDir{JFIF}) {
                $doneDir{JFIF} = 1;
                if ($verbose) {
                    print $out "Creating APP0:\n";
                    print $out "  Creating JFIF with default values\n";
                }
                my $jfif = "\x01\x02\x01\0\x48\0\x48\0\0";
                SetByteOrder('MM');
                my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Main');
                my %dirInfo = (
                    DataPt   => \$jfif,
                    DirStart => 0,
                    DirLen   => length $jfif,
                    Parent   => 'JFIF',
                );
                # must temporarily remove JFIF from DEL_GROUP so we can
                # delete JFIF and add it back again in a single step
                my $delJFIF = $$delGroup{JFIF};
                delete $$delGroup{JFIF};
                $$path[$pn] = 'JFIF';
                my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
                $$delGroup{JFIF} = $delJFIF if defined $delJFIF;
                if (defined $newData and length $newData) {
                    my $app0hdr = "\xff\xe0" . pack('n', length($newData) + 7);
                    Write($outfile,$app0hdr,"JFIF\0",$newData) or $err = 1;
                }
            }
            # don't create anything before APP0 or APP1 EXIF (containing IFD0)
            last if $markerName eq 'APP0' or $dirCount{IFD0};
            # EXIF information must come immediately after APP0
            if (exists $$addDirs{IFD0} and not defined $doneDir{IFD0}) {
                $doneDir{IFD0} = 1;
                $verbose and print $out "Creating APP1:\n";
                # write new EXIF data
                $$self{TIFF_TYPE} = 'APP1';
                my $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main');
                my %dirInfo = (
                    DirName => 'IFD0',
                    Parent  => 'APP1',
                );
                $$path[$pn] = 'APP1';
                my $buff = $self->WriteDirectory(\%dirInfo, $tagTablePtr, \&WriteTIFF);
                if (defined $buff and length $buff) {
                    my $size = length($buff) + length($exifAPP1hdr);
                    if ($size <= $maxSegmentLen) {
                        # switch to buffered output if required
                        if (($$self{PREVIEW_INFO} or $$self{LeicaTrailer}) and not $oldOutfile) {
                            $writeBuffer = '';
                            $oldOutfile = $outfile;
                            $outfile = \$writeBuffer;
                            # account for segment, EXIF and TIFF headers
                            $$self{PREVIEW_INFO}{Fixup}{Start} += 18 if $$self{PREVIEW_INFO};
                            $$self{LeicaTrailer}{Fixup}{Start} += 18 if $$self{LeicaTrailer};
                        }
                        # write the new segment with appropriate header
                        my $app1hdr = "\xff\xe1" . pack('n', $size + 2);
                        Write($outfile,$app1hdr,$exifAPP1hdr,$buff) or $err = 1;
                    } else {
                        delete $$self{PREVIEW_INFO};
                        $self->Warn("EXIF APP1 segment too large! ($size bytes)");
                    }
                }
            }
            # APP13 Photoshop segment next
            last if $dirCount{Photoshop};
            if (exists $$addDirs{Photoshop} and not defined $doneDir{Photoshop}) {
                $doneDir{Photoshop} = 1;
                $verbose and print $out "Creating APP13:\n";
                # write new APP13 Photoshop record to memory
                my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main');
                my %dirInfo = (
                    Parent => 'APP13',
                );
                $$path[$pn] = 'APP13';
                my $buff = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
                if (defined $buff and length $buff) {
                    WriteMultiSegment($outfile, 0xed, $psAPP13hdr, \$buff) or $err = 1;
                    ++$$self{CHANGED};
                }
            }
            # then APP1 XMP segment
            last if $dirCount{XMP};
            if (exists $$addDirs{XMP} and not defined $doneDir{XMP}) {
                $doneDir{XMP} = 1;
                $verbose and print $out "Creating APP1:\n";
                # write new XMP data
                my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
                my %dirInfo = (
                    Parent      => 'APP1',
                    # specify MaxDataLen so XMP is split if required
                    MaxDataLen  => $maxXMPLen - length($xmpAPP1hdr),
                );
                $$path[$pn] = 'APP1';
                my $buff = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
                if (defined $buff and length $buff) {
                    WriteMultiXMP($self, $outfile, \$buff, $dirInfo{ExtendedXMP},
                                  $dirInfo{ExtendedGUID}) or $err = 1;
                }
            }
            # then APP2 ICC_Profile segment
            last if $dirCount{ICC_Profile};
            if (exists $$addDirs{ICC_Profile} and not defined $doneDir{ICC_Profile}) {
                $doneDir{ICC_Profile} = 1;
                next if $$delGroup{ICC_Profile} and $$delGroup{ICC_Profile} != 2;
                $verbose and print $out "Creating APP2:\n";
                # write new ICC_Profile data
                my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main');
                my %dirInfo = (
                    Parent   => 'APP2',
                );
                $$path[$pn] = 'APP2';
                my $buff = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
                if (defined $buff and length $buff) {
                    WriteMultiSegment($outfile, 0xe2, "ICC_PROFILE\0", \$buff, 'ICC') or $err = 1;
                    ++$$self{CHANGED};
                }
            }
            # then APP12 Ducky segment
            last if $dirCount{Ducky};
            if (exists $$addDirs{Ducky} and not defined $doneDir{Ducky}) {
                $doneDir{Ducky} = 1;
                $verbose and print $out "Creating APP12 Ducky:\n";
                # write new Ducky segment data
                my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::Ducky');
                my %dirInfo = (
                    Parent   => 'APP12',
                );
                $$path[$pn] = 'APP12';
                my $buff = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
                if (defined $buff and length $buff) {
                    my $size = length($buff) + 5;
                    if ($size <= $maxSegmentLen) {
                        # write the new segment with appropriate header
                        my $app12hdr = "\xff\xec" . pack('n', $size + 2);
                        Write($outfile, $app12hdr, 'Ducky', $buff) or $err = 1;
                    } else {
                        $self->Warn("Ducky APP12 segment too large! ($size bytes)");
                    }
                }
            }
            # then APP14 Adobe segment
            last if $dirCount{Adobe};
            if (exists $$addDirs{Adobe} and not defined $doneDir{Adobe}) {
                $doneDir{Adobe} = 1;
                my $buff = $self->GetNewValue('Adobe');
                if ($buff) {
                    $verbose and print $out "Creating APP14:\n  Creating Adobe segment\n";
                    my $size = length($buff);
                    if ($size <= $maxSegmentLen) {
                        # write the new segment with appropriate header
                        my $app14hdr = "\xff\xee" . pack('n', $size + 2);
                        Write($outfile, $app14hdr, $buff) or $err = 1;
                        ++$$self{CHANGED};
                    } else {
                        $self->Warn("Adobe APP14 segment too large! ($size bytes)");
                    }
                }
            }
            # finally, COM segment
            last if $dirCount{COM};
            if (exists $$addDirs{COM} and not defined $doneDir{COM}) {
                $doneDir{COM} = 1;
                next if $$delGroup{File} and $$delGroup{File} != 2;
                my $newComment = $self->GetNewValue('Comment');
                if (defined $newComment and length($newComment)) {
                    if ($verbose) {
                        print $out "Creating COM:\n";
                        $self->VerboseValue('+ Comment', $newComment);
                    }
                    WriteMultiSegment($outfile, 0xfe, '', \$newComment) or $err = 1;
                    ++$$self{CHANGED};
                }
            }
            last;   # didn't want to loop anyway
        }
        $$path[$pn] = $markerName;
        # decrement counter for this directory since we are about to process it
        --$dirCount{$dirName};
#
# rewrite existing segments
#
        # handle SOF markers: SOF0-SOF15, except DHT(0xc4), JPGA(0xc8) and DAC(0xcc)
        if (($marker & 0xf0) == 0xc0 and ($marker == 0xc0 or $marker & 0x03)) {
            $verbose and print $out "JPEG $markerName:\n";
            Write($outfile, $hdr, $segData) or $err = 1;
            next;
        } elsif ($marker == 0xda) {             # SOS
            pop @$path;
            $verbose and print $out "JPEG SOS\n";
            # write SOS segment
            $s = pack('n', length($segData) + 2);
            Write($outfile, $hdr, $s, $segData) or $err = 1;
            my ($buff, $endPos, $trailInfo);
            my $delPreview = $$self{DEL_PREVIEW};
            $trailInfo = IdentifyTrailer($raf) unless $$delGroup{Trailer};
            unless ($oldOutfile or $delPreview or $trailInfo or $$delGroup{Trailer}) {
                # blindly copy the rest of the file
                while ($raf->Read($buff, 65536)) {
                    Write($outfile, $buff) or $err = 1, last;
                }
                $rtnVal = 1;  # success unless we have a file write error
                last;         # all done
            }
            # write the rest of the image (as quickly as possible) up to the EOI
            my $endedWithFF;
            for (;;) {
                my $n = $raf->Read($buff, 65536) or last Marker;
                if (($endedWithFF and $buff =~ m/^\xd9/sg) or
                    $buff =~ m/\xff\xd9/sg)
                {
                    $rtnVal = 1; # the JPEG is OK
                    # write up to the EOI
                    my $pos = pos($buff);
                    Write($outfile, substr($buff, 0, $pos)) or $err = 1;
                    $buff = substr($buff, $pos);
                    last;
                }
                unless ($n == 65536) {
                    $self->Error('JPEG EOI marker not found');
                    last Marker;
                }
                Write($outfile, $buff) or $err = 1;
                $endedWithFF = substr($buff, 65535, 1) eq "\xff" ? 1 : 0;
            }
            # remember position of last data copied
            $endPos = $raf->Tell() - length($buff);
            # rewrite trailers if they exist
            if ($trailInfo) {
                my $tbuf = '';
                $raf->Seek(-length($buff), 1);  # seek back to just after EOI
                $$trailInfo{OutFile} = \$tbuf;  # rewrite the trailer
                $$trailInfo{ScanForAFCP} = 1;   # scan if necessary
                $self->ProcessTrailers($trailInfo) or undef $trailInfo;
            }
            if (not $oldOutfile) {
                # do nothing special
            } elsif ($$self{LeicaTrailer}) {
                my $trailLen;
                if ($trailInfo) {
                    $trailLen = $$trailInfo{DataPos} - $endPos;
                } else {
                    $raf->Seek(0, 2) or $err = 1;
                    $trailLen = $raf->Tell() - $endPos;
                }
                my $fixup = $$self{LeicaTrailer}{Fixup};
                $$self{LeicaTrailer}{TrailPos} = $endPos;
                $$self{LeicaTrailer}{TrailLen} = $trailLen;
                # get _absolute_ position of new Leica trailer
                my $absPos = Tell($oldOutfile) + length($$outfile);
                require Image::ExifTool::Panasonic;
                my $dat = Image::ExifTool::Panasonic::ProcessLeicaTrailer($self, $absPos);
                # allow some junk before Leica trailer (just in case)
                my $junk = $$self{LeicaTrailerPos} - $endPos;
                # set MakerNote pointer and size (subtract 10 for segment and EXIF headers)
                $fixup->SetMarkerPointers($outfile, 'LeicaTrailer', length($$outfile) - 10 + $junk);
                # use this fixup to set the size too (sneaky)
                my $trailSize = defined($dat) ? length($dat) - $junk : $$self{LeicaTrailer}{Size};
                $$fixup{Start} -= 4;  $$fixup{Shift} += 4;
                $fixup->SetMarkerPointers($outfile, 'LeicaTrailer', $trailSize) if defined $trailSize;
                $$fixup{Start} += 4;  $$fixup{Shift} -= 4;
                # clean up and write the buffered data
                $outfile = $oldOutfile;
                undef $oldOutfile;
                Write($outfile, $writeBuffer) or $err = 1;
                undef $writeBuffer;
                if (defined $dat) {
                    Write($outfile, $dat) or $err = 1;  # write new Leica trailer
                    $delPreview = 1;                    # delete existing Leica trailer
                }
            } else {
                # locate preview image and fix up preview offsets
                my $scanLen = $$self{Make} =~ /^SONY/i ? 65536 : 1024;
                if (length($buff) < $scanLen) { # make sure we have enough trailer to scan
                    my $buf2;
                    $buff .= $buf2 if $raf->Read($buf2, $scanLen - length($buff));
                }
                # get new preview image position, relative to EXIF base
                my $newPos = length($$outfile) - 10; # (subtract 10 for segment and EXIF headers)
                my $junkLen;
                # adjust position if image isn't at the start (eg. Olympus E-1/E-300)
                if ($buff =~ /(\xff\xd8\xff.|.\xd8\xff\xdb)(..)/sg) {
                    my ($jpegHdr, $segLen) = ($1, $2);
                    $junkLen = pos($buff) - 6;
                    # Sony previewimage trailer has a 32 byte header
                    if ($$self{Make} =~ /^SONY/i and $junkLen > 32) {
                        # with some newer Sony models, the makernotes preview pointer
                        # points to JPEG at end of EXIF inside MPImage preview (what a pain!)
                        if ($jpegHdr eq "\xff\xd8\xff\xe1") {   # is the first segment EXIF?
                            $segLen = unpack('n', $segLen);     # the EXIF segment length
                            # Sony PreviewImage starts with last 2 bytes of EXIF segment
                            # (and first byte is usually "\0", not "\xff", so don't check this)
                            if (length($buff) > $junkLen + $segLen + 6 and
                                substr($buff, $junkLen + $segLen + 3, 3) eq "\xd8\xff\xdb")
                            {
                                $junkLen += $segLen + 2;
                                # (note: this will not copy the trailer after PreviewImage,
                                #  which is a 14kB block full of zeros for the A77)
                            }
                        }
                        $junkLen -= 32;
                    }
                    $newPos += $junkLen;
                }
                # fix up the preview offsets to point to the start of the new image
                my $previewInfo = $$self{PREVIEW_INFO};
                delete $$self{PREVIEW_INFO};
                my $fixup = $$previewInfo{Fixup};
                $newPos += ($$previewInfo{BaseShift} || 0);
                # adjust to absolute file offset if necessary (Samsung STMN)
                $newPos += Tell($oldOutfile) + 10 if $$previewInfo{Absolute};
                if ($$previewInfo{Relative}) {
                    # adjust for our base by looking at how far the pointer got shifted
                    $newPos -= ($fixup->GetMarkerPointers($outfile, 'PreviewImage') || 0);
                } elsif ($$previewInfo{ChangeBase}) {
                    # Leica S2 uses relative offsets for the preview only (leica sucks)
                    my $makerOffset = $fixup->GetMarkerPointers($outfile, 'LeicaTrailer');
                    $newPos -= $makerOffset if $makerOffset;
                }
                $fixup->SetMarkerPointers($outfile, 'PreviewImage', $newPos);
                # clean up and write the buffered data
                $outfile = $oldOutfile;
                undef $oldOutfile;
                Write($outfile, $writeBuffer) or $err = 1;
                undef $writeBuffer;
                # write preview image
                if ($$previewInfo{Data} ne 'LOAD_PREVIEW') {
                    # write any junk that existed before the preview image
                    Write($outfile, substr($buff,0,$junkLen)) or $err = 1 if $junkLen;
                    # write the saved preview image
                    Write($outfile, $$previewInfo{Data}) or $err = 1;
                    delete $$previewInfo{Data};
                    # (don't increment CHANGED because we could be rewriting existing preview)
                    $delPreview = 1;    # remove old preview
                }
            }
            # copy over preview image if necessary
            unless ($delPreview) {
                my $extra;
                if ($trailInfo) {
                    # copy everything up to start of first processed trailer
                    $extra = $$trailInfo{DataPos} - $endPos;
                } else {
                    # copy everything up to end of file
                    $raf->Seek(0, 2) or $err = 1;
                    $extra = $raf->Tell() - $endPos;
                }
                if ($extra > 0) {
                    if ($$delGroup{Trailer}) {
                        $verbose and print $out "  Deleting unknown trailer ($extra bytes)\n";
                        ++$$self{CHANGED};
                    } else {
                        # copy over unknown trailer
                        $verbose and print $out "  Preserving unknown trailer ($extra bytes)\n";
                        $raf->Seek($endPos, 0) or $err = 1;
                        CopyBlock($raf, $outfile, $extra) or $err = 1;
                    }
                }
            }
            # write trailer if necessary
            if ($trailInfo) {
                $self->WriteTrailerBuffer($trailInfo, $outfile) or $err = 1;
                undef $trailInfo;
            }
            last;   # all done parsing file

        } elsif ($marker==0xd9 and $isEXV) {
            # write EXV EOI
            Write($outfile, "\xff\xd9") or $err = 1;
            $rtnVal = 1;
            last;

        } elsif ($marker==0x00 or $marker==0x01 or ($marker>=0xd0 and $marker<=0xd7)) {
            $verbose and $marker and print $out "JPEG $markerName:\n";
            # handle stand-alone markers 0x00, 0x01 and 0xd0-0xd7 (NULL, TEM, RST0-RST7)
            Write($outfile, $hdr) or $err = 1;
            next;
        }
        #
        # NOTE: A 'next' statement after this point will cause $$segDataPt
        #       not to be written if there is an output file, so in this case
        #       the $$self{CHANGED} flags must be updated
        #
        my $segDataPt = \$segData;
        $length = length($segData);
        if ($verbose) {
            print $out "JPEG $markerName ($length bytes):\n";
            if ($verbose > 2 and $markerName =~ /^APP/) {
                HexDump($segDataPt, undef, %dumpParms);
            }
        }
        # group delete of APP segements
        if ($$delGroup{$dirName}) {
            $verbose and print $out "  Deleting $dirName segment\n";
            ++$$self{CHANGED};
            next Marker;
        }
        my ($segType, $del);
        # rewrite this segment only if we are changing a tag which is contained in its
        # directory (or deleting '*', in which case we need to identify the segment type)
        while (exists $$editDirs{$markerName} or $$delGroup{'*'}) {
            my $oldChanged = $$self{CHANGED};
            if ($marker == 0xe0) {              # APP0 (JFIF, CIFF)
                if ($$segDataPt =~ /^JFIF\0/) {
                    $segType = 'JFIF';
                    $$delGroup{JFIF} and $del = 1, last;
                    last unless $$editDirs{JFIF};
                    SetByteOrder('MM');
                    my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Main');
                    my %dirInfo = (
                        DataPt   => $segDataPt,
                        DataPos  => $segPos,
                        DataLen  => $length,
                        DirStart => 5,     # directory starts after identifier
                        DirLen   => $length-5,
                        Parent   => $markerName,
                    );
                    my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
                    if (defined $newData and length $newData) {
                        $$segDataPt = "JFIF\0" . $newData;
                    }
                } elsif ($$segDataPt =~ /^JFXX\0\x10/) {
                    $segType = 'JFXX';
                    $$delGroup{JFIF} and $del = 1;
                } elsif ($$segDataPt =~ /^(II|MM).{4}HEAPJPGM/s) {
                    $segType = 'CIFF';
                    $$delGroup{CIFF} and $del = 1, last;
                    last unless $$editDirs{CIFF};
                    my $newData = '';
                    my %dirInfo = (
                        RAF => new File::RandomAccess($segDataPt),
                        OutFile => \$newData,
                    );
                    require Image::ExifTool::CanonRaw;
                    if (Image::ExifTool::CanonRaw::WriteCRW($self, \%dirInfo) > 0) {
                        if (length $newData) {
                            $$segDataPt = $newData;
                        } else {
                            undef $segDataPt;
                            $del = 1;   # delete this segment
                        }
                    }
                }
            } elsif ($marker == 0xe1) {         # APP1 (EXIF, XMP)
                # check for EXIF data
                if ($$segDataPt =~ /^(.{0,4})$exifAPP1hdr/is) {
                    my $hdrLen = length $exifAPP1hdr;
                    if (length $1) {
                        $hdrLen += length $1;
                        $self->Error('Unknown garbage at start of EXIF segment',1);
                    } elsif ($$segDataPt !~ /^Exif\0/) {
                        $self->Error('Incorrect EXIF segment identifier',1);
                    }
                    $segType = 'EXIF';
                    $doneDir{IFD0} and $self->Warn('Multiple APP1 EXIF segments');
                    $doneDir{IFD0} = 1;
                    last unless $$editDirs{IFD0};
                    # check del groups now so we can change byte order in one step
                    if ($$delGroup{IFD0} or $$delGroup{EXIF}) {
                        delete $doneDir{IFD0};  # delete so we will create a new one
                        $del = 1;
                        last;
                    }
                    # rewrite EXIF as if this were a TIFF file in memory
                    my %dirInfo = (
                        DataPt   => $segDataPt,
                        DataPos  => -$hdrLen, # (remember: relative to Base!)
                        DirStart => $hdrLen,
                        Base     => $segPos + $hdrLen,
                        Parent   => $markerName,
                        DirName  => 'IFD0',
                    );
                    # write new EXIF data to memory
                    my $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main');
                    my $buff = $self->WriteDirectory(\%dirInfo, $tagTablePtr, \&WriteTIFF);
                    if (defined $buff) {
                        # update segment with new data
                        $$segDataPt = $exifAPP1hdr . $buff;
                    } else {
                        last Marker unless $self->Options('IgnoreMinorErrors');
                        $$self{CHANGED} = $oldChanged; # nothing changed
                    }
                    # switch to buffered output if required
                    if (($$self{PREVIEW_INFO} or $$self{LeicaTrailer}) and not $oldOutfile) {
                        $writeBuffer = '';
                        $oldOutfile = $outfile;
                        $outfile = \$writeBuffer;
                        # must account for segment, EXIF and TIFF headers
                        $$self{PREVIEW_INFO}{Fixup}{Start} += 18 if $$self{PREVIEW_INFO};
                        $$self{LeicaTrailer}{Fixup}{Start} += 18 if $$self{LeicaTrailer};
                    }
                    # delete segment if IFD contains no entries
                    $del = 1 unless length($$segDataPt) > length($exifAPP1hdr);
                # check for XMP data
                } elsif ($$segDataPt =~ /^($xmpAPP1hdr|$xmpExtAPP1hdr)/) {
                    $segType = 'XMP';
                    $$delGroup{XMP} and $del = 1, last;
                    $doneDir{XMP} = ($doneDir{XMP} || 0) + 1;
                    last unless $$editDirs{XMP};
                    if ($doneDir{XMP} + $dirCount{XMP} > 1) {
                        # must assemble all XMP segments before writing
                        my ($guid, $extXMP);
                        if ($$segDataPt =~ /^$xmpExtAPP1hdr/) {
                            # save extended XMP data
                            if (length $$segDataPt < 75) {
                                $extendedXMP{Error} = 'Truncated data';
                            } else {
                                my ($size, $off) = unpack('x67N2', $$segDataPt);
                                $guid = substr($$segDataPt, 35, 32);
                                if ($guid =~ /[^A-Za-z0-9]/) { # (technically, should be uppercase)
                                    $extendedXMP{Error} = 'Invalid GUID';
                                } else {
                                    # remember extended data for each GUID
                                    $extXMP = $extendedXMP{$guid};
                                    if ($extXMP) {
                                        $size == $$extXMP{Size} or $extendedXMP{Error} = 'Inconsistent size';
                                    } else {
                                        $extXMP = $extendedXMP{$guid} = { };
                                    }
                                    $$extXMP{Size} = $size;
                                    $$extXMP{$off} = substr($$segDataPt, 75);
                                }
                            }
                        } else {
                            # save all main XMP segments (should normally be only one)
                            $extendedXMP{Main} = [] unless $extendedXMP{Main};
                            push @{$extendedXMP{Main}}, substr($$segDataPt, length $xmpAPP1hdr);
                        }
                        # continue processing only if we have read all the segments
                        next Marker if $dirCount{XMP};
                        # reconstruct an XMP super-segment
                        $$segDataPt = $xmpAPP1hdr;
                        my $goodGuid = '';
                        foreach (@{$extendedXMP{Main}}) {
                            # get the HasExtendedXMP GUID if it exists
                            if (/:HasExtendedXMP\s*(=\s*['"]|>)(\w{32})/) {
                                # warn of subsequent XMP blocks specifying a different
                                # HasExtendedXMP (have never seen this)
                                if ($goodGuid and $goodGuid ne $2) {
                                    $self->WarnOnce('Multiple XMP segments specifying different extended XMP GUID');
                                }
                                $goodGuid = $2; # GUID for the standard extended XMP
                            }
                            $$segDataPt .= $_;
                        }
                        # GUID of the extended XMP that we want to read
                        my $readGuid = $$self{OPTIONS}{ExtendedXMP} || 0;
                        $readGuid = $goodGuid if $readGuid eq '1';
                        foreach $guid (sort keys %extendedXMP) {
                            next unless length $guid == 32;     # ignore other (internal) keys
                            if ($guid ne $readGuid and $readGuid ne '2') {
                                my $non = $guid eq $goodGuid ? '' : 'non-';
                                $self->Warn("Ignored ${non}standard extended XMP (GUID $guid)");
                                next;
                            }
                            if ($guid ne $goodGuid) {
                                $self->Warn("Reading non-standard extended XMP (GUID $guid)");
                            }
                            $extXMP = $extendedXMP{$guid};
                            next unless ref $extXMP eq 'HASH';  # (just to be safe)
                            my $size = $$extXMP{Size};
                            my (@offsets, $off);
                            for ($off=0; $off<$size; ) {
                                last unless defined $$extXMP{$off};
                                push @offsets, $off;
                                $off += length $$extXMP{$off};
                            }
                            if ($off == $size) {
                                # add all XMP to super-segment
                                $$segDataPt .= $$extXMP{$_} foreach @offsets;
                            } else {
                                $self->Error("Incomplete extended XMP (GUID $guid)", 1);
                            }
                        }
                        $self->Error("$extendedXMP{Error} in extended XMP", 1) if $extendedXMP{Error};
                    }
                    my $start = length $xmpAPP1hdr;
                    my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
                    my %dirInfo = (
                        DataPt     => $segDataPt,
                        DirStart   => $start,
                        Parent     => $markerName,
                        # limit XMP size and create extended XMP if necessary
                        MaxDataLen => $maxXMPLen - length($xmpAPP1hdr),
                    );
                    my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
                    if (defined $newData) {
                        undef %extendedXMP;
                        if (length $newData) {
                            # write multi-segment XMP (XMP plus extended XMP if necessary)
                            WriteMultiXMP($self, $outfile, \$newData, $dirInfo{ExtendedXMP},
                                          $dirInfo{ExtendedGUID}) or $err = 1;
                            undef $$segDataPt;  # free the old buffer
                            next Marker;
                        } else {
                            $$segDataPt = '';   # delete the XMP
                        }
                    } else {
                        $$self{CHANGED} = $oldChanged;
                        $verbose and print $out "    [XMP rewritten with no changes]\n";
                        if ($doneDir{XMP} > 1) {
                            # re-write original multi-segment XMP
                            my ($dat, $guid, $extXMP, $off);
                            foreach $dat (@{$extendedXMP{Main}}) {      # main XMP
                                next unless length $dat;
                                $s = pack('n', length($xmpAPP1hdr) + length($dat) + 2);
                                Write($outfile, $hdr, $s, $xmpAPP1hdr, $dat) or $err = 1;
                            }
                            foreach $guid (sort keys %extendedXMP) {    # extended XMP
                                next unless length $guid == 32;
                                $extXMP = $extendedXMP{$guid};
                                next unless ref $extXMP eq 'HASH';
                                my $size = $$extXMP{Size} or next;
                                for ($off=0; defined $$extXMP{$off}; $off += length $$extXMP{$off}) {
                                    $s = pack('n', length($xmpExtAPP1hdr) + length($$extXMP{$off}) + 42);
                                    Write($outfile, $hdr, $s, $xmpExtAPP1hdr, $guid,
                                          pack('N2', $size, $off), $$extXMP{$off}) or $err = 1;
                                }
                            }
                            undef $$segDataPt;  # free the old buffer
                            undef %extendedXMP;
                            next Marker;
                        }
                        # continue on to re-write original single-segment XMP
                    }
                    $del = 1 unless length $$segDataPt;
                } elsif ($$segDataPt =~ /^http/ or $$segDataPt =~ /<exif:/) {
                    $self->Warn('Ignored APP1 XMP segment with non-standard header', 1);
                }
            } elsif ($marker == 0xe2) {         # APP2 (ICC Profile, FPXR, MPF)
                if ($$segDataPt =~ /^ICC_PROFILE\0/ and $length >= 14) {
                    $segType = 'ICC_Profile';
                    $$delGroup{ICC_Profile} and $del = 1, last;
                    # must concatenate blocks of profile
                    my $chunkNum = Get8u($segDataPt, 12);
                    my $chunksTot = Get8u($segDataPt, 13);
                    if (defined $iccChunksTotal) {
                        # abort parsing ICC_Profile if the total chunk count is inconsistent
                        if ($chunksTot != $iccChunksTotal and defined $iccChunkCount) {
                            # an error because the accumulated profile data will be lost
                            $self->Error('Inconsistent ICC_Profile chunk count', 1);
                            undef $iccChunkCount; # abort ICC_Profile parsing
                            undef $chunkNum;      # avoid 2nd warning below
                            ++$$self{CHANGED};    # we are deleting the bad chunks before this one
                        }
                    } else {
                        $iccChunkCount = 0;
                        $iccChunksTotal = $chunksTot;
                        $self->Warn('ICC_Profile chunk count is zero') if !$chunksTot;
                    }
                    if (defined $iccChunkCount) {
                        # save this chunk
                        if (defined $iccChunk[$chunkNum]) {
                            $self->Warn("Duplicate ICC_Profile chunk number $chunkNum");
                            $iccChunk[$chunkNum] .= substr($$segDataPt, 14);
                        } else {
                            $iccChunk[$chunkNum] = substr($$segDataPt, 14);
                        }
                        # continue accumulating chunks unless we have all of them
                        next Marker unless ++$iccChunkCount >= $iccChunksTotal;
                        undef $iccChunkCount;   # prevent reprocessing
                        $doneDir{ICC_Profile} = 1;
                        # combine the ICC_Profile chunks
                        my $icc_profile = '';
                        defined $_ and $icc_profile .= $_ foreach @iccChunk;
                        undef @iccChunk;   # free memory
                        $segDataPt = \$icc_profile;
                        $length = length $icc_profile;
                        my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main');
                        my %dirInfo = (
                            DataPt   => $segDataPt,
                            DataPos  => $segPos + 14,
                            DataLen  => $length,
                            DirStart => 0,
                            DirLen   => $length,
                            Parent   => $markerName,
                        );
                        my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
                        if (defined $newData) {
                            undef $$segDataPt;  # free the old buffer
                            $segDataPt = \$newData;
                        }
                        length $$segDataPt or $del = 1, last;
                        # write as ICC multi-segment
                        WriteMultiSegment($outfile, $marker, "ICC_PROFILE\0", $segDataPt, 'ICC') or $err = 1;
                        undef $$segDataPt;
                        next Marker;
                    } elsif (defined $chunkNum) {
                        $self->WarnOnce('Invalid or extraneous ICC_Profile chunk(s)');
                        # fall through to preserve this extra profile...
                    }
                } elsif ($$segDataPt =~ /^FPXR\0/) {
                    $segType = 'FPXR';
                    $$delGroup{FlashPix} and $del = 1;
                } elsif ($$segDataPt =~ /^MPF\0/) {
                    $segType = 'MPF';
                    $$delGroup{MPF} and $del = 1;
                }
            } elsif ($marker == 0xe3) {         # APP3 (Kodak Meta)
                if ($$segDataPt =~ /^(Meta|META|Exif)\0\0/) {
                    $segType = 'Kodak Meta';
                    $$delGroup{Meta} and $del = 1, last;
                    $doneDir{Meta} and $self->Warn('Multiple APP3 Meta segments');
                    $doneDir{Meta} = 1;
                    last unless $$editDirs{Meta};
                    # rewrite Meta IFD as if this were a TIFF file in memory
                    my %dirInfo = (
                        DataPt   => $segDataPt,
                        DataPos  => -6, # (remember: relative to Base!)
                        DirStart => 6,
                        Base     => $segPos + 6,
                        Parent   => $markerName,
                        DirName  => 'Meta',
                    );
                    # write new data to memory
                    my $tagTablePtr = GetTagTable('Image::ExifTool::Kodak::Meta');
                    my $buff = $self->WriteDirectory(\%dirInfo, $tagTablePtr, \&WriteTIFF);
                    if (defined $buff) {
                        # update segment with new data
                        $$segDataPt = substr($$segDataPt,0,6) . $buff;
                    } else {
                        last Marker unless $self->Options('IgnoreMinorErrors');
                        $$self{CHANGED} = $oldChanged; # nothing changed
                    }
                    # delete segment if IFD contains no entries
                    $del = 1 unless length($$segDataPt) > 6;
                }
            } elsif ($marker == 0xe5) {         # APP5 (Ricoh RMETA)
                if ($$segDataPt =~ /^RMETA\0/) {
                    $segType = 'Ricoh RMETA';
                    $$delGroup{RMETA} and $del = 1;
                }
            } elsif ($marker == 0xec) {         # APP12 (Ducky)
                if ($$segDataPt =~ /^Ducky/) {
                    $segType = 'Ducky';
                    $$delGroup{Ducky} and $del = 1, last;
                    $doneDir{Ducky} and $self->Warn('Multiple APP12 Ducky segments');
                    $doneDir{Ducky} = 1;
                    last unless $$editDirs{Ducky};
                    my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::Ducky');
                    my %dirInfo = (
                        DataPt   => $segDataPt,
                        DataPos  => $segPos,
                        DataLen  => $length,
                        DirStart => 5,     # directory starts after identifier
                        DirLen   => $length-5,
                        Parent   => $markerName,
                    );
                    my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
                    if (defined $newData) {
                        undef $$segDataPt;  # free the old buffer
                        # add header to new segment unless empty
                        $newData = 'Ducky' . $newData if length $newData;
                        $segDataPt = \$newData;
                    } else {
                        $$self{CHANGED} = $oldChanged;
                    }
                    $del = 1 unless length $$segDataPt;
                }
            } elsif ($marker == 0xed) {         # APP13 (Photoshop)
                if ($$segDataPt =~ /^$psAPP13hdr/) {
                    $segType = 'Photoshop';
                    # add this data to the combined data if it exists
                    if (defined $combinedSegData) {
                        $combinedSegData .= substr($$segDataPt,length($psAPP13hdr));
                        $segDataPt = \$combinedSegData;
                        $length = length $combinedSegData;  # update length
                    }
                    # peek ahead to see if the next segment is photoshop data too
                    if ($dirOrder[0] eq 'Photoshop') {
                        # initialize combined data if necessary
                        $combinedSegData = $$segDataPt unless defined $combinedSegData;
                        next Marker;    # get the next segment to combine
                    }
                    if ($doneDir{Photoshop}) {
                        $self->Warn('Multiple Photoshop records');
                        # only rewrite the first Photoshop segment when deleting this group
                        # (to remove multiples when deleting and adding back in one step)
                        $$delGroup{Photoshop} and $del = 1, last;
                    }
                    $doneDir{Photoshop} = 1;
                    # process APP13 Photoshop record
                    my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main');
                    my %dirInfo = (
                        DataPt   => $segDataPt,
                        DataPos  => $segPos,
                        DataLen  => $length,
                        DirStart => 14,     # directory starts after identifier
                        DirLen   => $length-14,
                        Parent   => $markerName,
                    );
                    my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
                    if (defined $newData) {
                        undef $$segDataPt;  # free the old buffer
                        $segDataPt = \$newData;
                    } else {
                        $$self{CHANGED} = $oldChanged;
                    }
                    length $$segDataPt or $del = 1, last;
                    # write as multi-segment
                    WriteMultiSegment($outfile, $marker, $psAPP13hdr, $segDataPt) or $err = 1;
                    undef $combinedSegData;
                    undef $$segDataPt;
                    next Marker;
                }
            } elsif ($marker == 0xee) {         # APP14 (Adobe)
                if ($$segDataPt =~ /^Adobe/) {
                    $segType = 'Adobe';
                    # delete it and replace it later if editing
                    if ($$delGroup{Adobe} or $$editDirs{Adobe}) {
                        $del = 1;
                        undef $doneDir{Adobe};  # so we can add it back again above
                    }
                }
            } elsif ($marker == 0xfe) {         # COM (JPEG comment)
                my $newComment;
                unless ($doneDir{COM}) {
                    $doneDir{COM} = 1;
                    unless ($$delGroup{File} and $$delGroup{File} != 2) {
                        my $tagInfo = $Image::ExifTool::Extra{Comment};
                        my $nvHash = $self->GetNewValueHash($tagInfo);
                        my $val = $segData;
                        $val =~ s/\0+$//;   # allow for stupid software that adds NULL terminator
                        if ($self->IsOverwriting($nvHash, $val) or $$delGroup{File}) {
                            $newComment = $self->GetNewValue($nvHash);
                        } else {
                            delete $$editDirs{COM}; # we aren't editing COM after all
                            last;
                        }
                    }
                }
                $self->VerboseValue('- Comment', $$segDataPt);
                if (defined $newComment and length $newComment) {
                    # write out the comments
                    $self->VerboseValue('+ Comment', $newComment);
                    WriteMultiSegment($outfile, 0xfe, '', \$newComment) or $err = 1;
                } else {
                    $verbose and print $out "  Deleting COM segment\n";
                }
                ++$$self{CHANGED};      # increment the changed flag
                undef $segDataPt;       # don't write existing comment
            }
            last;   # didn't want to loop anyway
        }

        # delete necessary segments (including unknown segments if deleting all)
        if ($del or ($$delGroup{'*'} and not $segType and $marker>=0xe0 and $marker<=0xef)) {
            $segType = 'unknown' unless $segType;
            $verbose and print $out "  Deleting $markerName $segType segment\n";
            ++$$self{CHANGED};
            next Marker;
        }
        # write out this segment if $segDataPt is still defined
        if (defined $segDataPt and defined $$segDataPt) {
            # write the data for this record (the data could have been
            # modified, so recalculate the length word)
            my $size = length($$segDataPt);
            if ($size > $maxSegmentLen) {
                $segType or $segType = 'Unknown';
                $self->Error("$segType $markerName segment too large! ($size bytes)");
                $err = 1;
            } else {
                $s = pack('n', length($$segDataPt) + 2);
                Write($outfile, $hdr, $s, $$segDataPt) or $err = 1;
            }
            undef $$segDataPt;  # free the buffer
            undef $segDataPt;
        }
    }
    # make sure the ICC_Profile was complete
    $self->Error('Incomplete ICC_Profile record', 1) if defined $iccChunkCount;
    pop @$path if @$path > $pn;
    # if oldOutfile is still set, there was an error copying the JPEG
    $oldOutfile and return 0;
    if ($rtnVal) {
        # add any new trailers we are creating
        my $trailPt = $self->AddNewTrailers();
        Write($outfile, $$trailPt) or $err = 1 if $trailPt;
    }
    # set return value to -1 if we only had a write error
    $rtnVal = -1 if $rtnVal and $err;
    if ($creatingEXV and $rtnVal > 0 and not $$self{CHANGED}) {
        $self->Error('Nothing written');
        $rtnVal = -1;
    }
    return $rtnVal;
}

#------------------------------------------------------------------------------
# Validate an image for writing
# Inputs: 0) ExifTool object reference, 1) raw value reference
# Returns: error string or undef on success
sub CheckImage($$)
{
    my ($self, $valPtr) = @_;
    if (length($$valPtr) and $$valPtr!~/^\xff\xd8/ and not
        $self->Options('IgnoreMinorErrors'))
    {
        return '[minor] Not a valid image';
    }
    return undef;
}

#------------------------------------------------------------------------------
# check a value for validity
# Inputs: 0) value reference, 1) format string, 2) optional count
# Returns: error string, or undef on success
# Notes: May modify value (if a count is specified for a string, it is null-padded
# to the specified length, and floating point values are rounded to integer if required)
sub CheckValue($$;$)
{
    my ($valPtr, $format, $count) = @_;
    my (@vals, $val, $n);

    if ($format eq 'string' or $format eq 'undef') {
        return undef unless $count and $count > 0;
        my $len = length($$valPtr);
        if ($format eq 'string') {
            $len >= $count and return 'String too long';
        } else {
            $len > $count and return 'Data too long';
        }
        if ($len < $count) {
            $$valPtr .= "\0" x ($count - $len);
        }
        return undef;
    }
    if ($count and $count != 1) {
        @vals = split(' ',$$valPtr);
        $count < 0 and ($count = @vals or return undef);
    } else {
        $count = 1;
        @vals = ( $$valPtr );
    }
    if (@vals != $count) {
        my $str = @vals > $count ? 'Too many' : 'Not enough';
        return "$str values specified ($count required)";
    }
    for ($n=0; $n<$count; ++$n) {
        $val = shift @vals;
        if ($format =~ /^int/) {
            # make sure the value is integer
            unless (IsInt($val)) {
                if (IsHex($val)) {
                    $val = $$valPtr = hex($val);
                } else {
                    # round single floating point values to the nearest integer
                    return 'Not an integer' unless IsFloat($val) and $count == 1;
                    $val = $$valPtr = int($val + ($val < 0 ? -0.5 : 0.5));
                }
            }
            my $rng = $intRange{$format} or return "Bad int format: $format";
            return "Value below $format minimum" if $val < $$rng[0];
            # (allow 0xfeedfeed code as value for 16-bit pointers)
            return "Value above $format maximum" if $val > $$rng[1] and $val != 0xfeedfeed;
        } elsif ($format =~ /^rational/ or $format eq 'float' or $format eq 'double') {
            # make sure the value is a valid floating point number
            unless (IsFloat($val)) {
                # allow 'inf', 'undef' and fractional rational values
                if ($format =~ /^rational/) {
                    next if $val eq 'inf' or $val eq 'undef';
                    if ($val =~ m{^([-+]?\d+)/(\d+)$}) {
                        next unless $1 < 0 and $format =~ /u$/;
                        return 'Must be an unsigned rational';
                    }
                }
                return 'Not a floating point number';
            }
            if ($format =~ /^rational\d+u$/ and $val < 0) {
                return 'Must be a positive number';
            }
        }
    }
    return undef;   # success!
}

#------------------------------------------------------------------------------
# check new value for binary data block
# Inputs: 0) ExifTool object ref, 1) tagInfo hash ref, 2) raw value ref
# Returns: error string or undef (and may modify value) on success
sub CheckBinaryData($$$)
{
    my ($self, $tagInfo, $valPtr) = @_;
    my $format = $$tagInfo{Format};
    unless ($format) {
        my $table = $$tagInfo{Table};
        if ($table and $$table{FORMAT}) {
            $format = $$table{FORMAT};
        } else {
            # use default 'int8u' unless specified
            $format = 'int8u';
        }
    }
    my $count;
    if ($format =~ /(.*)\[(.*)\]/) {
        $format = $1;
        $count = $2;
        # can't evaluate $count now because we don't know $size yet
        undef $count if $count =~ /\$size/;
    }
    return CheckValue($valPtr, $format, $count);
}

#------------------------------------------------------------------------------
# Rename a file (with patch for Windows Unicode file names, and other problem)
# Inputs: 0) ExifTool ref, 1) old name, 2) new name
# Returns: true on success
sub Rename($$$)
{
    my ($self, $old, $new) = @_;
    my ($result, $try, $winUni);

    if ($self->EncodeFileName($old)) {
        $self->EncodeFileName($new, 1);
        $winUni = 1;
    } elsif ($self->EncodeFileName($new)) {
        $old = $_[1];
        $self->EncodeFileName($old, 1);
        $winUni = 1;
    }
    for (;;) {
        if ($winUni) {
            $result = eval { Win32API::File::MoveFileExW($old, $new,
                Win32API::File::MOVEFILE_REPLACE_EXISTING() |
                Win32API::File::MOVEFILE_COPY_ALLOWED()) };
        } else {
            $result = rename($old, $new);
        }
        last if $result or $^O ne 'MSWin32';
        # keep trying for up to 0.5 seconds
        # (patch for Windows denial-of-service susceptibility)
        $try = ($try || 1) + 1;
        last if $try > 50;
        select(undef,undef,undef,0.01); # sleep for 0.01 sec
    }
    return $result;
}

#------------------------------------------------------------------------------
# Delete a file (with patch for Windows Unicode file names)
# Inputs: 0) ExifTool ref, 1-N) names of files to delete
# Returns: number of files deleted
sub Unlink($@)
{
    my $self = shift;
    my $result = 0;
    while (@_) {
        my $file = shift;
        if ($self->EncodeFileName($file)) {
            ++$result if eval { Win32API::File::DeleteFileW($file) };
        } else {
            ++$result if unlink $file;
        }
    }
    return $result;
}

#------------------------------------------------------------------------------
# Set file times (Unix seconds since the epoch)
# Inputs: 0) ExifTool ref, 1) file name or ref, 2) access time, 3) modification time,
#         4) inode change or creation time (or undef for any time to avoid setting)
# Returns: 1 on success, 0 on error
my $k32SetFileTime;
sub SetFileTime($$;$$$)
{
    my ($self, $file, $atime, $mtime, $ctime) = @_;

    # open file by name if necessary
    unless (ref $file) {
        local *FH;
        $self->Open(\*FH, $file, '+<') or $self->Warn("SetFileTime error for '$file'"), return 0;
        $file = *FH;  # (not \*FH, so *FH will be kept open until $file goes out of scope)
    }
    # on Windows, try to work around incorrect file times when daylight saving time is in effect
    if ($^O eq 'MSWin32') {
        if (not eval { require Win32::API }) {
            $self->WarnOnce('Install Win32::API for proper handling of Windows file times');
        } elsif (not eval { require Win32API::File }) {
            $self->WarnOnce('Install Win32API::File for proper handling of Windows file times');
        } else {
            # get Win32 handle, needed for SetFileTime
            my $win32Handle = eval { Win32API::File::GetOsFHandle($file) };
            unless ($win32Handle) {
                $self->Warn("Win32API::File::GetOsFHandle returned invalid handle");
                return 0;
            }
            # convert Unix seconds to FILETIME structs
            my $time;
            foreach $time ($atime, $mtime, $ctime) {
                # set to NULL if not defined (i.e. do not change)
                defined $time or $time = 0, next;
                # convert to 100 ns intervals since 0:00 UTC Jan 1, 1601
                # (89 leap years between 1601 and 1970)
                my $wt = ($time + (((1970-1601)*365+89)*24*3600)) * 1e7;
                my $hi = int($wt / 4294967296);
                $time = pack 'LL', int($wt - $hi * 4294967296), $hi; # pack FILETIME struct
            }
            unless ($k32SetFileTime) {
                return 0 if defined $k32SetFileTime;
                $k32SetFileTime = new Win32::API('KERNEL32', 'SetFileTime', 'NPPP', 'I');
                unless ($k32SetFileTime) {
                    $self->Warn('Error calling Win32::API::SetFileTime');
                    $k32SetFileTime = 0;
                    return 0;
                }
            }
            unless ($k32SetFileTime->Call($win32Handle, $ctime, $atime, $mtime)) {
                $self->Warn("Win32::API::SetFileTime returned " . Win32::GetLastError());
                return 0;
            }
            return 1;
        }
    }
    # other os (or Windows fallback)
    return utime($atime, $mtime, $file) if defined $atime and defined $mtime;
    return 1; # (nothing to do)
}

#------------------------------------------------------------------------------
# Copy data block from RAF to output file in max 64kB chunks
# Inputs: 0) RAF ref, 1) outfile ref, 2) block size
# Returns: 1 on success, 0 on read error, undef on write error
sub CopyBlock($$$)
{
    my ($raf, $outfile, $size) = @_;
    my $buff;
    for (;;) {
        last unless $size > 0;
        my $n = $size > 65536 ? 65536 : $size;
        $raf->Read($buff, $n) == $n or return 0;
        Write($outfile, $buff) or return undef;
        $size -= $n;
    }
    return 1;
}

#------------------------------------------------------------------------------
# copy image data from one file to another
# Inputs: 0) ExifTool object reference
#         1) reference to list of image data [ position, size, pad bytes ]
#         2) output file ref
# Returns: true on success
sub CopyImageData($$$)
{
    my ($self, $imageDataBlocks, $outfile) = @_;
    my $raf = $$self{RAF};
    my ($dataBlock, $err);
    my $num = @$imageDataBlocks;
    $self->VPrint(0, "  Copying $num image data blocks\n") if $num;
    foreach $dataBlock (@$imageDataBlocks) {
        my ($pos, $size, $pad) = @$dataBlock;
        $raf->Seek($pos, 0) or $err = 'read', last;
        my $result = CopyBlock($raf, $outfile, $size);
        $result or $err = defined $result ? 'read' : 'writ';
        # pad if necessary
        Write($outfile, "\0" x $pad) or $err = 'writ' if $pad;
        last if $err;
    }
    if ($err) {
        $self->Error("Error ${err}ing image data");
        return 0;
    }
    return 1;
}

#------------------------------------------------------------------------------
# write to binary data block
# Inputs: 0) ExifTool object ref, 1) source dirInfo ref, 2) tag table ref
# Returns: Binary data block or undefined on error
sub WriteBinaryData($$$)
{
    my ($self, $dirInfo, $tagTablePtr) = @_;
    $self or return 1;    # allow dummy access to autoload this package

    # get default format ('int8u' unless specified)
    my $dataPt = $$dirInfo{DataPt} or return undef;
    my $defaultFormat = $$tagTablePtr{FORMAT} || 'int8u';
    my $increment = FormatSize($defaultFormat);
    unless ($increment) {
        warn "Unknown format $defaultFormat\n";
        return undef;
    }
    # extract data members first if necessary
    my @varOffsets;
    if ($$tagTablePtr{DATAMEMBER}) {
        $$dirInfo{DataMember} = $$tagTablePtr{DATAMEMBER};
        $$dirInfo{VarFormatData} = \@varOffsets;
        $self->ProcessBinaryData($dirInfo, $tagTablePtr);
        delete $$dirInfo{DataMember};
        delete $$dirInfo{VarFormatData};
    }
    my $dirStart = $$dirInfo{DirStart} || 0;
    my $dirLen = $$dirInfo{DirLen} || length($$dataPt) - $dirStart;
    my $newData = substr($$dataPt, $dirStart, $dirLen) or return undef;
    my $dirName = $$dirInfo{DirName};
    my $varSize = 0;
    my @varInfo = @varOffsets;
    my $tagInfo;
    $dataPt = \$newData;
    foreach $tagInfo ($self->GetNewTagInfoList($tagTablePtr)) {
        my $tagID = $$tagInfo{TagID};
        # evaluate conditional tags now if necessary
        if (ref $$tagTablePtr{$tagID} eq 'ARRAY' or $$tagInfo{Condition}) {
            my $writeInfo = $self->GetTagInfo($tagTablePtr, $tagID);
            next unless $writeInfo and $writeInfo eq $tagInfo;
        }
        # add offsets for variable-sized tags if necessary
        my $varFmt;
        while (@varInfo and $varInfo[0][0] < $tagID) {
            $varSize = $varInfo[0][1];  # get accumulated variable size
            shift @varInfo;
        }
        my $count = 1;
        my $format = $$tagInfo{Format};
        my $entry = int($tagID) * $increment + $varSize; # relative offset of this entry
        if ($format) {
            if ($format =~ /(.*)\[(.*)\]/) {
                $format = $1;
                $count = $2;
                my $size = $dirLen; # used in eval
                # evaluate count to allow count to be based on previous values
                #### eval Format size ($size, $self) - NOTE: %val not supported for writing
                $count = eval $count;
                $@ and warn($@), next;
            } elsif ($format eq 'string') {
                # string with no specified count runs to end of block
                $count = ($dirLen > $entry) ? $dirLen - $entry : 0;
            }
        } else {
            $format = $defaultFormat;
        }
        # read/write using variable format if changed in Hook
        $format = $varInfo[0][2] if @varInfo and $varInfo[0][0] == $tagID;
        my $val = ReadValue($dataPt, $entry, $format, $count, $dirLen-$entry);
        next unless defined $val;
        my $nvHash = $self->GetNewValueHash($tagInfo, $$self{CUR_WRITE_GROUP});
        next unless $self->IsOverwriting($nvHash, $val);
        my $newVal = $self->GetNewValue($nvHash);
        next unless defined $newVal;    # can't delete from a binary table
        # only write masked bits if specified
        my $mask = $$tagInfo{Mask};
        $newVal = ($newVal & $mask) | ($val & ~$mask) if defined $mask;
        # set the size
        if ($$tagInfo{DataTag} and not $$tagInfo{IsOffset}) {
            warn 'Internal error' unless $newVal == 0xfeedfeed;
            my $data = $self->GetNewValue($$tagInfo{DataTag});
            $newVal = length($data) if defined $data;
            my $format = $$tagInfo{Format} || $$tagTablePtr{FORMAT} || 'int32u';
            if ($format =~ /^int16/ and $newVal > 0xffff) {
                $self->Error("$$tagInfo{DataTag} is too large (64 kB max. for this file)");
            }
        }
        my $rtnVal = WriteValue($newVal, $format, $count, $dataPt, $entry);
        if (defined $rtnVal) {
            $self->VerboseValue("- $dirName:$$tagInfo{Name}", $val);
            $self->VerboseValue("+ $dirName:$$tagInfo{Name}", $newVal);
            ++$$self{CHANGED};
        }
    }
    # add necessary fixups for any offsets
    if ($$tagTablePtr{IS_OFFSET} and $$dirInfo{Fixup}) {
        $varSize = 0;
        @varInfo = @varOffsets;
        my $fixup = $$dirInfo{Fixup};
        my $tagID;
        foreach $tagID (@{$$tagTablePtr{IS_OFFSET}}) {
            $tagInfo = $self->GetTagInfo($tagTablePtr, $tagID) or next;
            while (@varInfo and $varInfo[0][0] < $tagID) {
                $varSize = $varInfo[0][1];
                shift @varInfo;
            }
            my $entry = $tagID * $increment + $varSize; # (no offset to dirStart for new dir data)
            next unless $entry <= $dirLen - 4;
            # (Ricoh has 16-bit preview image offsets, so can't just assume int32u)
            my $format = $$tagInfo{Format} || $$tagTablePtr{FORMAT} || 'int32u';
            my $offset = ReadValue($dataPt, $entry, $format, 1, $dirLen-$entry);
            # ignore if offset is zero (eg. Ricoh DNG uses this to indicate no preview)
            next unless $offset;
            $fixup->AddFixup($entry, $$tagInfo{DataTag}, $format);
            # handle the preview image now if this is a JPEG file
            next unless $$self{FILE_TYPE} eq 'JPEG' and $$tagInfo{DataTag} and
                $$tagInfo{DataTag} eq 'PreviewImage' and defined $$tagInfo{OffsetPair};
            # NOTE: here we assume there are no var-sized tags between the
            # OffsetPair tags.  If this ever becomes possible we must recalculate
            # $varSize for the OffsetPair tag here!
            $entry = $$tagInfo{OffsetPair} * $increment + $varSize;
            my $size = ReadValue($dataPt, $entry, $format, 1, $dirLen-$entry);
            my $previewInfo = $$self{PREVIEW_INFO};
            $previewInfo or $previewInfo = $$self{PREVIEW_INFO} = {
                Fixup => new Image::ExifTool::Fixup,
            };
            # set flag indicating we are using short pointers
            $$previewInfo{IsShort} = 1 unless $format eq 'int32u';
            $$previewInfo{Absolute} = 1 if $$tagInfo{IsOffset} and $$tagInfo{IsOffset} eq '3';
            # get the value of the Composite::PreviewImage tag
            $$previewInfo{Data} = $self->GetNewValue($Image::ExifTool::Composite{PreviewImage});
            unless (defined $$previewInfo{Data}) {
                if ($offset >= 0 and $offset + $size <= $$dirInfo{DataLen}) {
                    $$previewInfo{Data} = substr(${$$dirInfo{DataPt}},$offset,$size);
                } else {
                    $$previewInfo{Data} = 'LOAD_PREVIEW'; # flag to load preview later
                }
            }
        }
    }
    # write any necessary SubDirectories
    if ($$tagTablePtr{IS_SUBDIR}) {
        $varSize = 0;
        @varInfo = @varOffsets;
        my $tagID;
        foreach $tagID (@{$$tagTablePtr{IS_SUBDIR}}) {
            my $tagInfo = $self->GetTagInfo($tagTablePtr, $tagID);
            next unless defined $tagInfo;
            while (@varInfo and $varInfo[0][0] < $tagID) {
                $varSize = $varInfo[0][1];
                shift @varInfo;
            }
            my $entry = int($tagID) * $increment + $varSize;
            last if $entry >= $dirLen;
            # get value for Condition if necessary
            unless ($tagInfo) {
                my $more = $dirLen - $entry;
                $more = 128 if $more > 128;
                my $v = substr($newData, $entry, $more);
                $tagInfo = $self->GetTagInfo($tagTablePtr, $tagID, \$v);
                next unless $tagInfo;
            }
            next unless $$tagInfo{SubDirectory}; # (just to be safe)
            my %subdirInfo = ( DataPt => \$newData, DirStart => $entry );
            my $subTablePtr = GetTagTable($$tagInfo{SubDirectory}{TagTable});
            my $dat = $self->WriteDirectory(\%subdirInfo, $subTablePtr);
            substr($newData, $entry) = $dat if defined $dat and length $dat;
        }
    }
    return $newData;
}

#------------------------------------------------------------------------------
# Write TIFF as a directory
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: New directory data or undefined on error
sub WriteTIFF($$$)
{
    my ($self, $dirInfo, $tagTablePtr) = @_;
    my $buff = '';
    $$dirInfo{OutFile} = \$buff;
    return $buff if $self->ProcessTIFF($dirInfo, $tagTablePtr) > 0;
    return undef;
}

1; # end

__END__

=head1 NAME

Image::ExifTool::Writer.pl - ExifTool routines for writing meta information

=head1 SYNOPSIS

These routines are autoloaded by Image::ExifTool when required.

=head1 DESCRIPTION

This module contains ExifTool write routines and other infrequently
used routines.

=head1 AUTHOR

Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

L<Image::ExifTool(3pm)|Image::ExifTool>

=cut