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
|
package Mail::IMAPClient;
# $Id: IMAPClient.pm,v 20001010.9 2001/02/07 20:19:50 dkernen Exp $
$Mail::IMAPClient::VERSION = '2.1.4';
$Mail::IMAPClient::VERSION = '2.1.4'; # do it twice to make sure it takes
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
use Socket();
use IO::Socket();
use IO::Select();
use IO::File();
use Carp qw(carp);
use Data::Dumper;
use Errno qw/EAGAIN/;
#print "Found Fcntl in $INC{'Fcntl.pm'}\n";
#Fcntl->import;
=head1 NAME
Mail::IMAPClient - An IMAP Client API
=cut
use constant Unconnected => 0;
use constant Connected => 1; # connected; not logged in
use constant Authenticated => 2; # logged in; no mailbox selected
use constant Selected => 3; # mailbox selected
use constant INDEX => 0; # Array index for output line number
use constant TYPE => 1; # Array index for output line type (OUTPUT,INPUT, or LITERAL)
use constant DATA => 2; # Array index for output line data
sub _debug {
my $self = shift;
return unless $self->Debug;
my $fh = $self->{Debug_fh} || \*STDERR;
print $fh @_;
}
sub MaxTempErrors {
my $self = shift;
$_[0]->{Maxtemperrors} = $_[1] if defined($_[1]);
return $_[0]->{Maxtemperrors};
}
# This function is used by the accessor methods
#
sub _do_accessor {
my $datum = shift;
if ( defined($_[1]) and $datum eq 'Fast_io' and ref($_[0]->{Socket})) {
if ($_[1]) { # Passed the "True" flag
my $fcntl = 0;
eval { $fcntl=fcntl($_[0]->{Socket}, F_GETFL, 0) } ;
if ($@) {
$_[0]->{Fast_io} = 0;
carp ref($_[0]) . " not using Fast_IO; not available on this platform"
if ( ( $^W or $_[0]->Debug) and not $_[0]->{_fastio_warning_}++);
} else {
$_[0]->{Fast_io} = 1;
$_[0]->{_fcntl} = $fcntl;
my $newflags = $fcntl;
$newflags |= O_NONBLOCK;
fcntl($_[0]->{Socket}, F_SETFL, $newflags) ;
}
} else {
fcntl($_[0]->{Socket}, F_SETFL, $_[0]->{_fcntl}) ;
$_[0]->{Fast_io} = 0;
delete $_[0]->{_fcntl};
}
} elsif ( defined($_[1]) and $datum eq 'Socket' ) {
# Get rid of fcntl settings for obsolete socket handles:
delete $_[0]->{_fcntl} ;
# Register this handle in a select vector:
$_[0]->{_select} = IO::Select->new($_[1]) ;
}
if (scalar(@_) > 1) {
$@ = $_[1] if $datum eq 'LastError';
return $_[0]->{$datum} = $_[1] ;
} else {
return $_[0]->{$datum};
}
}
# the following for loop sets up eponymous accessor methods for
# the object's parameters:
BEGIN {
for my $datum (
qw( State Port Server Folder Fast_io Peek
User Password Socket Timeout Buffer
Debug LastError Count Uid Debug_fh Maxtemperrors
)
) {
no strict 'refs';
*$datum = sub { _do_accessor($datum, @_); };
}
}
sub Wrap { shift->Clear(@_); }
# The following class method is for creating valid dates in appended msgs:
sub Rfc822_date {
my $class= shift;
#Date: Fri, 09 Jul 1999 13:10:55 -0000#
my $date = $class =~ /^\d+$/ ? $class : shift ;
my @date = gmtime($date);
my @dow = qw{ Sun Mon Tue Wed Thu Fri Sat };
my @mnt = qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
#
return sprintf(
"%s, %2.2d %s %4.4s %2.2d:%2.2d:%2.2d -%4.4d",
$dow[$date[6]],
$date[3],
$mnt[$date[4]],
$date[5]+=1900,
$date[2],
$date[1],
$date[0],
$date[8]) ;
}
# The following class method is for creating valid dates for use in IMAP search strings:
sub Rfc2060_date {
my $class= shift;
# 11-Jan-2000
my $date = $class =~ /^\d+$/ ? $class : shift ;
my @date = gmtime($date);
my @mnt = qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
#
return sprintf(
"%2.2d-%s-%4.4s",
$date[3],
$mnt[$date[4]],
$date[5]+=1900
) ;
}
# The following class method strips out <CR>'s so lines end with <LF> instead of <CR><LF>:
sub Strip_cr {
my $class = shift;
unless ( ref($_[0]) or scalar(@_) > 1 ) {
(my $string = $_[0]) =~ s/\x0d\x0a/\x0a/gm;
return $string;
}
return wantarray ? map { s/\x0d\x0a/\0a/gm ; $_ } (ref($_[0]) ? @{$_[0]} : @_) :
[ map { s/\x0d\x0a/\x0a/gm ; $_ } ref($_[0]) ? @{$_[0]} : @_ ] ;
}
# The following defines a special method to deal with the Clear parameter:
sub Clear {
my $self = shift;
defined(my $clear = shift) or return $self->{Clear};
my $oldclear = $self->{Clear};
$self->{Clear} = $clear;
my (@keys) = sort { $b <=> $a } keys %{$self->{"History"}} ;
for ( my $i = $clear; $i < @keys ; $i++ ) { delete $self->{'History'}{$keys[$i]} }
return $oldclear;
}
# read-only access to the transaction number:
sub Transaction { shift->Count };
# the constructor:
sub new {
my $class = shift;
my $self = {
LastError => "",
Uid => 1,
Count => 0,
Fast_io => 1,
"Clear" => 5,
};
while (scalar(@_)) {
$self->{ucfirst(lc($_[0]))} = $_[1]; shift, shift;
}
bless $self, ref($class)||$class;
$self->State(Unconnected);
$self->{Debug_fh} ||= \*STDERR;
$self->_debug("Using Mail::IMAPClient version $Mail::IMAPClient::VERSION " .
"and perl version " . ( defined $^V ? join(".",unpack("CCC",$^V)) : "") .
" ($])\n") if $self->Debug;
$self->LastError(0);
return $self->connect if $self->Server and !$self->Socket;
return $self;
}
sub connect {
my $self = shift;
$self->Port(143)
if defined ($IO::Socket::INET::VERSION)
and $IO::Socket::INET::VERSION eq '1.25'
and !$self->Port;
%$self = (%$self, @_);
my $sock = IO::Socket::INET->new(
PeerAddr => $self->Server ,
PeerPort => $self->Port||'imap(143)' ,
Proto => 'tcp' ,
Timeout => $self->Timeout||0 ,
Debug => $self->Debug ,
) ;
unless ( defined($sock) ) {
$self->LastError( "Unable to connect to $self->{Server}: $!\n");
$@ = "Unable to connect to $self->{Server}: $!";
carp "Unable to connect to $self->{Server}: $!" unless defined wantarray;
return undef;
}
$self->Socket($sock);
$self->State(Connected);
$sock->autoflush(1) ;
my ($code, $output);
$output = "";
until ( $code ) {
$output = $self->_read_line or return undef;
for my $o (@$output) {
$self->_debug("Connect: Received this from readline: " . join("/",@$o) . "\n");
$self->_record($self->Count,$o); # $o is a ref
next unless $o->[TYPE] eq "OUTPUT";
($code) = $o->[DATA] =~ /^\*\s+(OK|BAD|NO)/i ;
}
}
if ($code =~ /BYE|NO /) {
$self->State(Unconnected);
return undef ;
}
if ($self->User and $self->Password) {
return $self->login ;
} else {
return $self;
}
}
sub login {
my $self = shift;
my $id = $self->User;
my $has_quotes = $id =~ /^".*"$/ ? 1 : 0;
my $string = "Login " . ( $has_quotes ? $id : qq("$id") ) . " " .
$self->Massage($self->Password) ;
$self->_imap_command($string)
and $self->State(Authenticated);
# $self->folders and $self->separator unless $self->NoAutoList;
unless ( $self->IsAuthenticated) {
my($carp) = $self->LastError;
$carp =~ s/^[\S]+ ([^\x0d\x0a]*)\x0d?\x0a/$1/;
carp $carp unless defined wantarray;
return undef;
}
return $self;
}
sub separator {
my $self = shift;
my $target = shift ;
unless ( defined($target) ) {
my $sep ;
# separator is namespace's 1st thing's 1st thing's 2nd thing:
eval { $sep = $self->namespace->[0][0][1] } ;
return $sep if $sep;
}
defined($target) or $target = "INBOX";
$target ||= '""' ;
# The fact that the response might end with {123} doesn't really matter here:
unless (exists $self->{"$target${;}SEPARATOR"}) {
my $list = (grep(/^\*\s+LIST\s+/, $self->list(undef,$target) ))[0] || qq("/");
my $s = (split(/\s+/,$list))[3];
$self->{"$target${;}SEPARATOR"} = ( $s eq 'NIL' ? 'NIL' : substr($s, 1,length($s)-2) );
}
return $self->{$target,'SEPARATOR'};
}
sub sort {
my $self = shift;
my @hits;
my @a = @_;
$a[0] = "($a[0])" unless $a[0] =~ /^\(.*\)$/; # wrap criteria in parens
$self->_imap_command( ( $self->Uid ? "UID " : "" ) . "SORT ". join(' ',@a))
or return wantarray ? @hits : \@hits ;
my @results = $self->History($self->Count);
for my $r (@results) {
chomp $r;
$r =~ s/\r$//;
$r =~ s/^\*\s+SORT\s+// or next;
push @hits, grep(/\d/,(split(/\s+/,$r)));
}
return wantarray ? @hits : \@hits;
}
sub list {
my $self = shift;
my ($reference, $target) = (shift, shift);
$reference = "" unless defined($reference);
$target = '*' unless defined($target);
$target = $self->Massage($target);
my $string = qq(LIST "$reference" $target);
$self->_imap_command($string) or return undef;
return wantarray ? $self->History($self->Count) :
[ map { $_->[DATA] } @{$self->{'History'}{$self->Count}} ] ;
}
sub lsub {
my $self = shift;
my ($reference, $target) = (shift, shift);
$reference = "" unless defined($reference);
$target = '*' unless defined($target);
$target = $self->Massage($target);
my $string = qq(LSUB "$reference" $target);
$self->_imap_command($string) or return undef;
return wantarray ? $self->History($self->Count) :
[ map { $_->[DATA] } @{$self->{'History'}{$self->Count}} ] ;
}
sub subscribed {
my $self = shift;
my $what = shift ;
my @folders ;
my @list = $self->lsub(undef,( $what? "$what" . $self->separator($what) . "*" : undef ) );
push @list, $self->lsub(undef, $what) if $what and $self->exists($what) ;
# my @list = map { $self->_debug("Pushing $_->[${\(DATA)}] \n"); $_->[DATA] } @$output;
my $m;
for ($m = 0; $m < scalar(@list); $m++ ) {
if ($list[$m] && $list[$m] !~ /\x0d\x0a$/ ) {
$list[$m] .= $list[$m+1] ;
$list[$m+1] = "";
}
# $self->_debug("Subscribed: examining $list[$m]\n");
push @folders, $1||$2
if $list[$m] =~
/ ^\*\s+LSUB # * LSUB
\s+\([^\)]*\)\s+ # (Flags)
(?:"[^"]*"|NIL)\s+ # "delimiter" or NIL
(?:"([^"]*)"|(.*))\x0d\x0a$ # Name or "Folder name"
/ix;
}
# for my $f (@folders) { $f =~ s/^\\FOLDER LITERAL:://;}
my @clean = () ; my %memory = ();
foreach my $f (@folders) { push @clean, $f unless $memory{$f}++ }
return wantarray ? @clean : \@clean ;
}
sub deleteacl {
my $self = shift;
my ($target, $user ) = @_;
$target = $self->Massage($target);
$user =~ s/^"(.*)"$/$1/;
$user =~ s/"/\\"/g;
my $string = qq(DELETEACL $target "$user");
$self->_imap_command($string) or return undef;
return wantarray ? $self->History($self->Count) :
[ map {$_->[DATA] } @{$self->{'History'}{$self->Count}}] ;
}
sub setacl {
my $self = shift;
my ($target, $user, $acl) = @_;
$user = $self->User unless length($user);
$target = $self->Folder unless length($target);
$target = $self->Massage($target);
$user =~ s/^"(.*)"$/$1/;
$user =~ s/"/\\"/g;
$acl =~ s/^"(.*)"$/$1/;
$acl =~ s/"/\\"/g;
my $string = qq(SETACL $target "$user" "$acl");
$self->_imap_command($string) or return undef;
return wantarray?$self->History($self->Count):[map{$_->[DATA]}@{$self->{'History'}{$self->Count}}];
}
sub getacl {
my $self = shift;
my ($target) = @_;
$target = $self->Folder unless defined($target);
my $mtarget = $self->Massage($target);
my $string = qq(GETACL $mtarget);
$self->_imap_command($string) or return undef;
my @history = $self->History($self->Count);
#$self->_debug("Getacl history: " . join("|",@history) . ">>>End of History<<<" ) ;
my $perm = "";
my $hash = {};
for ( my $x = 0; $x < scalar(@history) ; $x++ ) {
if ( $history[$x] =~ /^\* ACL/ ) {
$perm = $history[$x] =~ /^\* ACL $/ ? $history[++$x].$history[++$x] :
$history[$x];
$perm =~ s/\s?\x0d\x0a$//;
piece: until ( $perm =~ /\Q$target\E"?$/ or !$perm) {
#$self->_debug(qq(Piece: permline=$perm and pattern = /\Q$target\E"? \$/));
$perm =~ s/\s([^\s]+)\s?$// or last piece;
my($p) = $1;
$perm =~ s/\s([^\s]+)\s?$// or last piece;
my($u) = $1;
$hash->{$u} = $p;
$self->_debug("Permissions: $u => $p \n");
}
}
}
return $hash;
}
sub listrights {
my $self = shift;
my ($target, $user) = @_;
$user = $self->User unless defined($user);
$target = $self->Folder unless defined($target);
$target = $self->Massage($target);
$user =~ s/^"(.*)"$/$1/;
$user =~ s/"/\\"/g;
my $string = qq(LISTRIGHTS $target "$user");
$self->_imap_command($string) or return undef;
my $resp = ( grep(/^\* LISTRIGHTS/, $self->History($self->Count) ) )[0];
my @rights = split(/\s/,$resp);
shift @rights, shift @rights, shift @rights, shift @rights;
my $rights = join("",@rights);
$rights =~ s/"//g;
return wantarray ? split(//,$rights) : $rights ;
}
sub select {
my $self = shift;
my $target = shift ;
return undef unless defined($target);
my $qqtarget = $self->Massage($target);
my $string = qq/SELECT $qqtarget/;
my $old = $self->Folder;
if ($self->_imap_command($string) and $self->State(Selected)) {
$self->Folder($target);
return $old||$self;
} else {
return undef;
}
}
sub message_string {
my $self = shift;
my $msg = shift;
my $expected_size = $self->size($msg);
return undef unless(defined $expected_size); # unable to get size
my $cmd = $self->has_capability('IMAP4REV1') ?
"BODY" . ( $self->Peek ? '.PEEK[]' : '[]' ) :
"RFC822" . ( $self->Peek ? '.PEEK' : '' ) ;
$self->fetch($msg,$cmd) or return undef;
my $string = "";
foreach my $result (@{$self->{"History"}{$self->Transaction}}) {
$string .= $result->[DATA] if defined($result) and $self->_is_literal($result) ;
}
# BUG? should probably return undef if length != expected
if ( length($string) != $expected_size ) {
carp "${self}::message_string: expected $expected_size bytes but received " .
length($string)
if $self->Debug or $^W;
}
if ( length($string) > $expected_size ) { $string = substr($string,0,$expected_size) }
if ( length($string) < $expected_size ) {
$self->LastError("${self}::message_string: expected $expected_size bytes but received " .
length($string)."\n");
return undef;
}
return $string;
}
sub bodypart_string {
my($self, $msg, $partno) = @_;
unless ( $self->has_capability('IMAP4REV1') ) {
$self->LastError(
"Unable to get body part; server " .
$self->Server .
" does not support IMAP4REV1"
);
return undef;
}
my $cmd = "BODY" . ( $self->Peek ? ".PEEK[$partno]" : "[$partno]" ) ;
$self->fetch($msg,$cmd) or return undef;
my $string = "";
foreach my $result (@{$self->{"History"}{$self->Transaction}}) {
$string .= $result->[DATA] if defined($result) and $self->_is_literal($result) ;
}
return $string;
}
sub message_to_file {
my $self = shift;
my $fh = shift;
my @msgs = @_;
my $handle;
if ( ref($fh) ) {
$handle = $fh;
} else {
$handle = IO::File->new(">>$fh");
unless ( defined($handle)) {
$@ = "Unable to open $fh: $!";
$self->LastError("Unable to open $fh: $!\n");
carp $@ if $^W;
return undef;
}
binmode $handle; # For those of you who need something like this...
}
my $clear = "";
$clear = $self->Clear;
my $cmd = $self->Peek ? 'BODY.PEEK[]' : 'BODY[]';
$cmd = $self->Peek ? 'RFC822.PEEK' : 'RFC822' unless $self->imap4rev1;
my $string = ( $self->Uid ? "UID " : "" ) . "FETCH " . join(",",@msgs) . " $cmd";
$self->Clear($clear)
if $self->Count >= $clear and $clear > 0;
my $trans = $self->Count($self->Count+1);
$string = "$trans $string" ;
$self->_record($trans,[ 0, "INPUT", "$string\x0d\x0a"] );
my $feedback = $self->_send_line("$string");
unless ($feedback) {
$self->LastError( "Error sending '$string' to IMAP: $!\n");
$@ = "Error sending '$string' to IMAP: $!";
return undef;
}
my ($code, $output);
$output = "";
READ: until ( $code) {
$output = $self->_read_line($handle) or return undef; # avoid possible infinite loop
for my $o (@$output) {
$self->_record($trans,$o); # $o is a ref
# $self->_debug("Received from readline: ${\($o->[DATA])}<<END OF RESULT>>\n");
next unless $self->_is_output($o);
($code) = $o->[DATA] =~ /^$trans (OK|BAD|NO)/mi ;
if ($o->[DATA] =~ /^\*\s+BYE/im) {
$self->State(Unconnected);
return undef ;
}
}
}
# $self->_debug("Command $string: returned $code\n");
close $handle unless ref($fh);
return $code =~ /^OK/im ? $self : undef ;
}
sub message_uid {
my $self = shift;
my $msg = shift;
my @uid = $self->fetch($msg,"UID");
my $uid;
while ( my $u = shift @uid and !$uid) {
($uid) = $u =~ /\(UID\s+(\d+)\s*\)\r?$/;
}
return $uid;
}
sub migrate {
my($self,$peer,$msgs,$folder) = @_;
unless ( eval { $peer->isConnected } ) {
$self->LastError("Invalid or unconnected " . ref($self) . " object used as target for migrate.");
return undef;
}
unless ($folder) {
$folder = $self->Folder;
$peer->exists($folder) or
$peer->create($folder) or
(
$self->LastError("Unable to created folder $folder on target mailbox: ".
"$peer->LastError") and
return undef
) ;
}
if ( $msgs =~ /^all$/ ) { $msgs = $self->search("ALL") }
foreach my $mid ( ref($msgs) ? @$msgs : $msgs ) {
}
}
#sub old_body_string {
# my $self = shift;
# my $msg = shift;
# my @torso = $self->fetch($msg,"RFC822.TEXT");
# $torso[0] =~ s/.*FETCH \(.*RFC822\.TEXT //i;
# pop @torso and pop @torso;
# return join("",@torso);
#}
sub body_string {
my $self = shift;
my $msg = shift;
my $ref = $self->fetch($msg,"BODY" . ( $self->Peek ? ".PEEK" : "" ) . "[TEXT]");
my $string = "";
foreach my $result (@{$ref}) {
$string .= $result->[DATA] if defined($result) and $self->_is_literal($result) ;
}
return $string if $string;
my $head = shift @$ref;
$self->_debug("body_string: first shift = '$head'\n");
until ( (! $head) or $head =~ /(?:.*FETCH .*\(.*BODY\[TEXT\])|(?:^\d+ BAD )|(?:^\d NO )/i ) {
$self->_debug("body_string: shifted '$head'\n");
$head = shift(@$ref) ;
}
unless ( scalar(@$ref) ) {
$self->LastError("Unable to parse server response from " . $self->LastIMAPCommand );
return undef ;
}
my $popped ; $popped = pop @$ref until
(
( defined($popped) and
# (-: Smile!
$popped =~ /\)\x0d\x0a$/
) or
not grep(
# (-: Smile again!
/\)\x0d\x0a$/,
@$ref
)
);
if ($head =~ /BODY\[TEXT\]\s*$/i ) { # Next line is a literal
$string .= shift @$ref while scalar(@$ref);
$self->_debug("String is now $string\n") if $self->Debug;
}
return $string||undef;
}
sub examine {
my $self = shift;
my $target = shift ; return undef unless defined($target);
$target = $self->Massage($target);
my $string = qq/EXAMINE $target/;
my $old = $self->Folder;
if ($self->_imap_command($string) and $self->State(Selected)) {
$self->Folder($target);
return $old||$self;
} else {
return undef;
}
}
sub tag_and_run {
my $self = shift;
my $string = shift;
my $good = shift;
$self->_imap_command($string,$good);
return @{$self->Results};
}
# _{name} methods are undocumented and meant to be private.
# _imap_command runs a command, inserting the correct tag
# and <CR><LF> and whatnot.
# When updating _imap_command, remember to examine the run method, too, since it is very similar.
#
sub _imap_command {
my $self = shift;
my $string = shift or return undef;
my $good = shift || 'GOOD';
$good = quotemeta($good);
my $clear = "";
$clear = $self->Clear;
$self->Clear($clear)
if $self->Count >= $clear and $clear > 0;
my $count = $self->Count($self->Count+1);
$string = "$count $string" ;
$self->_record($count,[ 0, "INPUT", "$string\x0d\x0a"] );
my $feedback = $self->_send_line("$string");
unless ($feedback) {
$self->LastError( "Error sending '$string' to IMAP: $!\n");
$@ = "Error sending '$string' to IMAP: $!";
carp "Error sending '$string' to IMAP: $!" if $^W;
return undef;
}
my ($code, $output);
$output = "";
READ: until ( $code) {
$output = $self->_read_line or return undef; # escape infinite loop if read_line never returns any data
for my $o (@$output) {
$self->_record($count,$o); # $o is a ref
# $self->_debug("Received from readline: ${\($o->[DATA])}<<END OF RESULT>>\n");
next unless $self->_is_output($o);
($code) = $o->[DATA] =~ /^$count (OK|BAD|NO|$good)/mi ;
if ($o->[DATA] =~ /^\*\s+BYE/im) {
$self->State(Unconnected);
return undef ;
}
}
}
# $self->_debug("Command $string: returned $code\n");
return $code =~ /^OK|$good/im ? $self : undef ;
}
sub run {
my $self = shift;
my $string = shift or return undef;
my $good = shift || 'GOOD';
my $count = $self->Count($self->Count+1);
my($tag) = $string =~ /^(\S+) / ;
unless ($tag) {
$self->LastError("Invalid string passed to run method; no tag found.\n");
return undef;
}
$good = quotemeta($good);
my $clear = "";
$clear = $self->Clear;
$self->Clear($clear)
if $self->Count >= $clear and $clear > 0;
$self->_record($count,[ $self->_next_index($count), "INPUT", "$string\x0d\x0a"] );
my $feedback = $self->_send_line("$string");
unless ($feedback) {
$self->LastError( "Error sending '$string' to IMAP: $!\n");
return undef;
}
my ($code, $output);
$output = "";
until ( ($code) = $output =~ /^$tag (OK|BAD|NO|$good)/m ) {
$output = $self->_read_line or return undef;
for my $o (@$output) {
$self->_record($count,$o); # $o is a ref
next unless $self->_is_output($o);
($code) = $o->[DATA] =~ /^(?:$tag|\*) (OK|BAD|NO|$good)/m ;
if ($o->[DATA] =~ /^\*\s+BYE/) {
$self->State(Unconnected);
}
}
}
$self->{'History'}{$tag} = $self->{"History"}{$count} unless $tag eq $count;
return $code =~ /^OK|$good/ ? @{$self->Results} : undef ;
}
#sub bodystruct { # return bodystruct
#}
# _record saves the conversation into the History structure:
sub _record {
my ($self,$count,$array) = ( shift, shift, shift);
local($^W)= undef;
#$self->_debug(sprintf("in _record: count is $count, values are %s/%s/%s and caller is " .
# join(":",caller()) . "\n",@$array));
if ( # $array->[DATA] and
$array->[DATA] =~ /^\d+ LOGIN/i ) {
$array->[DATA] =~ s/LOGIN.*/LOGIN XXXXXXXX XXXXXXXX/i ;
}
push @{$self->{"History"}{$count}}, $array;
if ( $array->[DATA] =~ /^\d+\s+(BAD|NO)\s/im ) {
$self->LastError("$array->[DATA]") ;
$@ = $array->[DATA];
carp "$array->[DATA]" if $^W ;
}
return $self;
}
#_send_line writes to the socket:
sub _send_line {
my($self,$string,$suppress) = (shift, shift, shift);
unless ($self->IsConnected and $self->Socket) {
$self->LastError("NO Not connected.\n");
carp "Not connected" if $^W;
return undef;
}
unless ($string =~ /\x0d\x0a$/ or $suppress ) {
chomp $string;
$string .= "\x0d" unless $string =~ /\x0d$/;
$string .= "\x0a" ;
}
if ( $string =~ /^[^\x0a{]*\{(\d+)\}\x0d\x0a/ ) {
my($p1,$p2,$len) ;
if ( ($p1,$len) = $string =~ /^([^\x0a{]*\{(\d+)\}\x0d\x0a)/ # } for vi
and (
$len < 32766 ?
( ($p2) = $string =~ /^[^\x0a{]*\{\d+\}\x0d\x0a(.{$len}.*\x0d\x0a)/ ) :
( ($p2) = $string =~ /^[^\x0a{]*\{\d+\}\x0d\x0a(.*\x0d\x0a)/ and length($p2) == $len )
# }} for vi
)
) {
$self->_debug("Sending literal string in two parts: $p1\n\tthen: $p2\n");
$self->_send_line($p1) or return undef;
$output = $self->_read_line or return undef;
foreach my $o (@$output) {
$self->_record($self->Count,$o); # $o is already an array ref
($code) = $o->[DATA] =~ /(^\+|NO|BAD)/i;
if ($o->[DATA] =~ /^\*\s+BYE/) {
$self->State(Unconnected);
close $fh;
return undef ;
} elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
close $fh;
return undef;
}
}
if ( $code eq '+' ) { $string = $p2; } else { return undef ; }
}
}
if ($self->Debug) {
my $dstring = $string;
if ( $dstring =~ m[\d+\s+Login\s+]i) {
$dstring =~ s (\b(?:\Q$self->{Password}\E|\Q$self->{User}\E)\b)
('X' x length($self->{Password}))eg;
}
_debug $self, "Sending: $dstring\n" if $self->Debug;
}
my $total = 0;
my $temperrs = 0;
until ($total >= length($string)) {
my $ret = syswrite(
$self->Socket,
$string,
length($string)-$total,
$total
);
if ($! == &EAGAIN ) {
if ( $self->{Maxtemperrors} !~ /^unlimited/i and
$temperrs++ > ( $self->{Maxtemperrors}||10)
) {
$self->LastError("Persistent '${!}' errors\n");
$self->_debug("Persistent '${!}' errors\n");
return undef;
}
CORE::select(undef, undef, undef, .25 * $temperrs);
} else {
# avoid infinite loops on syswrite error
return undef unless(defined $ret);
}
if ( defined($ret) ) {
$temperrs = 0 ;
$total += $ret ;
}
}
_debug $self,"Sent $total bytes\n" if $self->Debug;
return $total;
}
#_read_line reads from the socket:
# sub _old_read_line {
# my $self = shift;
# my $sh = $self->Socket;
# my $buffer = "";
# my $count = ""; $count = 0;
# my $rvec = my $ready = my $errors = 0;
# my $timeout = $self->Timeout;
# my $readlen = 1;
# my $fcntl = '';
# my($flags,$in_literal) = ('0',0);
# if ( $self->Fast_io ) {
# eval { $fcntl=fcntl($sh, F_GETFL, $flags) } ;
# # _debug $self, STDERR
# # "Setfl = ",F_SETFL," and GETFL = ",F_GETFL," and NONBLOCK = ",O_NONBLOCK,"\n";
# # _debug $self, STDERR "Fcntl flag is now $fcntl\n";
# if ($@) {
# $self->Fast_io(0);
# carp ref($self) . " not using Fast_IO; not available on this platform.\n"
# if ( $^W or $self->Debug);
# } else {
# my $newflags = $fcntl;
# $newflags |= O_NONBLOCK;
# fcntl($sh, F_SETFL, $newflags) and $readlen = ($self->{Buffer}||4096);
# }
# }
# my $offset = 0;
# until ($buffer =~ /\r?\n$/ ) {
# # _debug $self,"Entering read engine.\n" if $self->Debug;
# if ($timeout) {
# vec($rvec, fileno($self->Socket), 1) = 1;
# CORE::select( $ready = $rvec, undef, $errors = $rvec, $timeout) ;
# unless ( vec ( $ready, fileno($self->Socket), 1 ) ) {
# $self->LastError("Tag " . $self->Transaction .
# ": Timeout waiting for data from server\n");
# fcntl($sh, F_SETFL, $fcntl)
# if $self->Fast_io and defined($fcntl);
# $self->_record($self->Transaction,
# [ $self->_next_index($self->Transaction),
# "ERROR",
# $self->Transaction . "* NO Timeout during read from server\r\n"
# ]
# );
# $@ = "Timeout during read from server\r\n";
# return undef;
# }
# }
# # _debug($self,"count is $count and length of buffer is " . length($buffer) . "\n");
# local($^W) = undef;
# $count += sysread(
# $sh,
# $buffer,
# $readlen,
# $offset
# ) ;
# $offset = $count ;
# pos $buffer = 1;
# LITERAL: while ( $buffer =~ /\{(\d+)\}\r\n/g and ! $in_literal ) {
# my $len = $1 ;
# $in_literal++;
# _debug $self, "Buffer:\n$buffer" . ('-' x 30) . "\n" if $self->Debug;
# $offset = $count - length($buffer) ;
# $count -= length("{" . "$len" . "}\r\n" ) ;
# # _debug($self, "Count = $count and offset = $offset\n") if $self->Debug;
# # If I used anything from the buffer for my literal then it needs to come
# # out of the buffer now: (use substr to avoid regexp overhead)
# substr($buffer , index($buffer, "{" . $len . "}\r\n"), length("{}\n\r" . $len)) = "";
# if ($timeout) {
# vec($rvec, fileno($self->Socket), 1) = 1;
# unless ( CORE::select( $ready = $rvec,
# undef,
# $errors = $rvec,
# $timeout)
# ) {
# $self->LastError("Tag " . $self->Transaction .
# ": Timeout waiting for literal data from server\n");
# return undef;
# }
# }
# until ( $offset >= $len ) {
# # _debug $self, "Reading literal data\n";
# $offset += sysread($sh,$buffer,$len-$offset, $count+$offset) ;
# }
# $count += $offset;
# pos $buffer = 1;
# }
# $offset = length($buffer);
# pos $buffer = 1;
# }
# fcntl($sh, F_SETFL, $fcntl) if $self->Fast_io and defined($fcntl);
# # _debug $self, "Buffer is now $buffer\n";
# _debug $self, "Read: $buffer\n" if $self->Debug;
# return defined($buffer) ? $buffer : undef ;
# }
# _read_line reads from the socket. It is called by:
# append append_file authenticate connect _imap_command
#
# It is also re-implemented in:
# message_to_file
#
# syntax: $output = $self->_readline( ( $literal_callback|undef ) , ( $output_callback|undef ) ) ;
# Both input argument are optional, but if supplied must either be a filehandle, coderef, or undef.
#
# Returned argument is a reference to an array of arrays, ie:
# $output = [
# [ $index, 'OUTPUT'|'LITERAL', $output_line ] ,
# [ $index, 'OUTPUT'|'LITERAL', $output_line ] ,
# ... # etc,
# ];
sub _read_line {
my $self = shift;
my $sh = $self->Socket;
my $literal_callback = shift;
my $output_callback = shift;
unless ($self->IsConnected and $self->Socket) {
$self->LastError("NO Not connected.\n");
carp "Not connected" if $^W;
return undef;
}
my $iBuffer = "";
my $oBuffer = [];
my $count = 0;
my $index = $self->_next_index($self->Transaction);
my $rvec = my $ready = my $errors = 0;
my $timeout = $self->Timeout;
my $readlen = 1;
my $fast_io = $self->Fast_io; # Remember setting to reduce future method calls
if ( $fast_io ) {
# set fcntl if necessary:
exists $self->{_fcntl} or $self->Fast_io($fast_io);
$readlen = $self->{Buffer}||4096;
}
until ( scalar(@$oBuffer) and # stuff in output buffer
$oBuffer->[-1][DATA] =~ /\x0d\x0a$/ and # the last thing there has cr-lf
$oBuffer->[-1][TYPE] eq "OUTPUT" and # that thing is an output line
$iBuffer eq "" # and # and the input buffer has been MT'ed
) {
my $transno = $self->Transaction; # used below in several places
if ($timeout) {
vec($rvec, fileno($self->Socket), 1) = 1;
my @ready = $self->{_select}->can_read($timeout) ;
unless ( @ready ) {
$self->LastError("Tag $transno: " .
"Timeout after $timeout seconds waiting for data from server\n");
$self->_record($transno,
[ $self->_next_index($transno),
"ERROR",
"$transno * NO Timeout after $timeout seconds " .
"during read from server\x0d\x0a"
]
);
$@ = "Timeout after $timeout seconds during read from server\x0d\x0a";
carp "Timeout after $timeout seconds during read from server: $!"
if $self->Debug or $^W;
return undef;
}
}
local($^W) = undef; # Now quiet down warnings
# read "$readlen" bytes (or less):
# need to check return code from sysread in case other end has shut down!!!
my $ret = sysread( $sh, $iBuffer, $readlen, length($iBuffer)) ;
# $self->_debug("Read so far: $iBuffer<<END>>\n");
if($timeout and ! defined($ret)) { # Blocking read error...
my $msg = "Error while reading data from server: $!\x0d\x0a";
$self->_record($transno,
[ $self->_next_index($transno),
"ERROR", "$transno * NO $msg "
]);
$@ = "$msg";
return undef;
}
elsif(defined($ret) and $ret == 0) { # Caught EOF...
my $msg="Socket closed while reading data from server.\x0d\x0a";
$self->_record($transno,
[ $self->_next_index($transno),
"ERROR", "$transno * NO $msg "
]);
$@ = "$msg";
return undef;
}
# successfully wrote to other end, keep going...
$count += $ret;
LINES: while ( $iBuffer =~ s/^(.*?\x0d?\x0a)// ) {
my $current_line = $1;
# $self->_debug("BUFFER: pulled from buffer: <BEGIN>${current_line}<END>\n" .
# "and left with buffer contents of: <BEGIN>${iBuffer}<END>\n");
LITERAL: if ($current_line =~ s/\{(\d+)\}\x0d\x0a$//) {
# This part handles IMAP "Literals", which according to rfc2060 look something like this:
# [tag]|* BLAH BLAH {nnn}\r\n
# [nnn bytes of literally transmitted stuff]
# [part of line that follows literal data]\r\n
# Set $len to be length of impending literal:
my $len = $1 ;
$self->_debug("LITERAL: received literal in line $current_line of length $len; ".
"attempting to ".
"retrieve from the " . length($iBuffer) . " bytes in: $iBuffer<END_OF_iBuffer>\n");
# Transfer up to $len bytes from front of $iBuffer to $litstring:
my $litstring = substr($iBuffer, 0, $len);
$iBuffer = substr($iBuffer, length($litstring), length($iBuffer) - length($litstring) ) ;
# Figure out what's left to read (i.e. what part of literal wasn't in buffer):
my $remainder_count = $len - length($litstring);
my $callback_value = "";
if ( defined($literal_callback) ) {
if ( $literal_callback =~ /GLOB/) {
print $literal_callback $litstring ;
$litstring = "";
} elsif ($literal_callback =~ /CODE/ ) {
# Don't do a thing
} else {
$self->LastError(
ref($literal_callback) .
" is an invalid callback type; must be a filehandle or coderef"
);
}
}
if ($remainder_count > 0 and $timeout) {
# If we're doing timeouts then here we set up select and wait for data from the
# the IMAP socket.
vec($rvec, fileno($self->Socket), 1) = 1;
unless ( CORE::select( $ready = $rvec,
undef,
$errors = $rvec,
$timeout)
) { # Select failed; that means bad news. Better tell someone.
$self->LastError("Tag " . $transno .
": Timeout waiting for literal data from server\n");
carp "Timeout waiting for literal data from server"
if $self->Debug or $^W;
return undef;
}
}
fcntl($sh, F_SETFL, $self->{_fcntl}) if $fast_io and defined($self->{_fcntl});
while ( $remainder_count > 0 ) { # As long literal not done,
my $ret = sysread( # bytes read
$sh, # IMAP handle
$litstring, # place to read into
$remainder_count, # bytes left to read
length($litstring) # offset to read into
) ;
if ( $timeout and !defined($ret)) { # possible timeout
$self->_record($transno, [
$self->_next_index($transno),
"ERROR",
"$transno * NO Error reading data from server: $!\n"
]
);
return undef;
} elsif ( $ret == 0 and eof($sh) ) {
$self->_record($transno, [
$self->_next_index($transno),
"ERROR",
"$transno * ".
"BYE Server unexpectedly closed connection: $!\n"
]
);
$self->State(Unconnected);
return undef;
}
$remainder_count -= $ret; # decrement remaining bytes by amt read
if ( defined($literal_callback) ) {
if ( $literal_callback =~ /GLOB/ ) {
print $literal_callback $litstring;
$litstring = "";
}
}
}
$literal_callback->($litstring)
if defined($litstring) and $literal_callback =~ /CODE/;
$self->Fast_io($fast_io) if $fast_io;
# Now let's make sure there are no IMAP server output lines
# (i.e. [tag|*] BAD|NO|OK Text) embedded in the literal string
# (There shouldn't be but I've seen it done!)
my $embedded_output = 0;
my $lastline = ( split(/\x0d?\x0a/,$litstring))[-1] if $litstring;
if ( $lastline and $lastline =~ /^(?:\*|(\d+))\s(BAD|NO|OK)/i ) {
$litstring =~ s/\Q$lastline\E\x0d?\x0a//;
$embedded_output++;
$self->_debug("Got server output mixed in with literal: ",
"$lastline\n")
if $self->Debug;
}
# Finally, we need to stuff the literal onto the end of the oBuffer:
push @$oBuffer , [ $index++, "OUTPUT", $current_line ] ,
[ $index++, "LITERAL", $litstring ];
push @$oBuffer, [ $index++, "OUTPUT", $lastline ]
if $embedded_output;
} else {
push @$oBuffer, [ $index++, "OUTPUT" , $current_line ];
}
}
#$self->_debug("iBuffer is now: $iBuffer<<END OF BUFFER>>\n");
}
# _debug $self, "Buffer is now $buffer\n";
_debug $self, "Read: " . join("",map {$_->[DATA]} @$oBuffer) ."\n" if $self->Debug;
return scalar(@$oBuffer) ? $oBuffer : undef ;
}
sub Report {
my $self = shift;
# $self->_debug( "Dumper: " . Data::Dumper::Dumper($self) .
# "\nReporting on following keys: " . join(", ",keys %{$self->{'History'}}). "\n");
return map {
map { $_->[DATA] } @{$self->{"History"}{$_}}
} sort { $a <=> $b } keys %{$self->{"History"}}
;
}
sub Results {
my $self = shift ;
my $transaction = shift||$self->Count;
return wantarray ?
map {$_->[DATA] } @{$self->{"History"}{$transaction}} :
[ map {$_->[DATA] } @{$self->{"History"}{$transaction}} ] ;
}
sub LastIMAPCommand {
my @a = map { $_->[DATA] } @{$_[0]->{"History"}{$_[1]||$_[0]->Transaction}};
return shift @a;
}
sub History {
my @a = map { $_->[DATA] } @{$_[0]->{"History"}{$_[1]||$_[0]->Transaction}};
shift @a;
return wantarray ? @a : \@a ;
}
sub Escaped_results {
my @a;
foreach my $line (@{$_[0]->{"History"}{$_[1]||$_[0]->Transaction}} ) {
if ( defined($line) and $_[0]->_is_literal($line) ) {
$line->[DATA] =~ s/([\\\(\)"\x0d\x0a])/\\$1/g ;
push @a, qq("$line->[DATA]");
} else {
push @a, $line->[DATA] ;
}
}
shift @a; # $a[0] is the ALWAYS the command ; I make sure of that in _imap_command
return wantarray ? @a : \@a ;
}
sub Unescape {
shift @_ if $_[1];
my $whatever = shift;
$whatever =~ s/\\([\\\(\)"\x0d\x0a])/$1/g ;
return $whatever;
}
sub logout {
my $self = shift;
my $string = "LOGOUT";
$self->_imap_command($string) ;
$self->State(Unconnected);
$self->{Folders} = undef;
$self->{_IMAP4REV1} = undef;
$self->Socket->close ; $self->{Socket} = undef;
return $self;
}
sub folders {
my $self = shift;
my $what = shift ;
return wantarray ? @{$self->{Folders}} :
$self->{Folders}
if ref($self->{Folders}) and !$what;
my @folders ;
my @list = $self->list(undef,( $what? "$what" . $self->separator($what) . "*" : undef ) );
push @list, $self->list(undef, $what) if $what and $self->exists($what) ;
# my @list =
# foreach (@list) { $self->_debug("Pushing $_\n"); }
my $m;
for ($m = 0; $m < scalar(@list); $m++ ) {
# $self->_debug("Folders: examining $list[$m]\n");
if ($list[$m] && $list[$m] !~ /\x0d\x0a$/ ) {
$self->_debug("folders: concatenating $list[$m] and " . $list[$m+1] . "\n") ;
$list[$m] .= $list[$m+1] ;
$list[$m+1] = "";
$list[$m] .= "\x0d\x0a" unless $list[$m] =~ /\x0d\x0a$/;
}
push @folders, $1||$2
if $list[$m] =~
/ ^\*\s+LIST # * LIST
\s+\([^\)]*\)\s+ # (Flags)
(?:"[^"]*"|NIL)\s+ # "delimiter" or NIL
(?:"([^"]*)"|(.*))\x0d\x0a$ # Name or "Folder name"
/ix;
# $self->_debug("folders: line $list[$m]: 1=$1 and 2=$2\n");
}
# for my $f (@folders) { $f =~ s/^\\FOLDER LITERAL:://;}
my @clean = (); my %memory = ();
foreach my $f (@folders) { push @clean, $f unless $memory{$f}++ }
$self->{Folders} = \@clean unless $what;
return wantarray ? @clean : \@clean ;
}
sub exists {
my ($self,$what) = (shift,shift);
return $self if $self->STATUS($self->Massage($what),"(MESSAGES)");
return undef;
}
sub get_bodystructure {
my($self,$msg) = @_;
unless ( eval {require Mail::IMAPClient::BodyStructure ; 1 } ) {
$self->LastError("Unable to use get_bodystructure: $@\n");
return undef;
}
return Mail::IMAPClient::BodyStructure->new(grep(/bodystructure \(/i,$self->fetch($msg,"BODYSTRUCTURE")));
}
sub fetch {
my $self = shift;
my $what = shift||"ALL";
ref($what) and $what = join(",",@$what);
$self->_imap_command( ( $self->Uid ? "UID " : "" ) .
"FETCH $what" . ( @_ ? " " . join(" ",@_) : '' )
) or return undef;
return wantarray ? $self->History($self->Count) :
[ map { $_->[DATA] } @{$self->{'History'}{$self->Count}} ];
}
sub AUTOLOAD {
my $self = shift;
return undef if $Mail::IMAPClient::AUTOLOAD =~ /DESTROY$/;
delete $self->{Folders} ;
my $autoload = $Mail::IMAPClient::AUTOLOAD;
$autoload =~ s/.*:://;
if (
$^W
and $autoload =~ /^[a-z]+$/
and $autoload !~
/^ (?:
store |
copy |
subscribe|
create |
delete |
close |
expunge
)$
/x
) {
carp "$autoload is all lower-case. " .
"May conflict with future methods. " .
"Change method name to be mixed case or all upper case to ensure upward compatability"
}
if (scalar(@_)) {
my @a = @_;
if (
$autoload =~
/^(?:subscribe|delete|myrights)$/i
) {
$a[-1] = $self->Massage($a[-1]) ;
} elsif (
$autoload =~
/^(?:create)$/i
) {
$a[0] = $self->Massage($a[0]) ;
} elsif (
$autoload =~ /^(?:store|copy)$/i
) {
$autoload = "UID $autoload"
if $self->Uid;
} elsif (
$autoload =~ /^(?:expunge)$/i and defined($_[0])
) {
my $old;
if ( $_[0] ne $self->Folder ) {
$old = $self->Folder; $self->select($_[0]);
}
my $succ = $self->_imap_command(qq/$autoload/) ;
$self->select($old);
return undef unless $succ;
return wantarray ? $self->History($self->Count) :
map {$_->[DATA]}@{$self->{'History'}{$self->Count}} ;
}
_debug $self, "Autoloading: $autoload " . join(" ",@a) ,"\n" if $self->Debug;
return undef unless $self->_imap_command(qq/$autoload / . join(" ",@a) ) ;
} else {
$self->Folder(undef) if $autoload =~ /^(?:close)/i ;
$self->_imap_command(qq/$autoload/) or return undef;
}
return wantarray ? $self->History($self->Count) :
[map {$_->[DATA] } @{$self->{'History'}{$self->Count}}] ;
}
sub rename {
my $self = shift;
my ($from, $to) = @_;
local($_);
if ($from =~ /^"(.*)"$/) {
$from = $1 unless $self->exists($from);
$from =~ s/"/\\"/g;
}
if ($to =~ /^"(.*)"$/) {
$to = $1 unless $self->exists($from) and $from =~ /^".*"$/;
$to =~ s/"/\\"/g;
}
$self->_imap_command(qq(RENAME "$from" "$to")) or return undef;
return $self;
}
sub status {
my $self = shift;
my $box = shift ;
return undef unless defined($box);
$box = $self->Massage($box);
my @pieces = @_;
$self->_imap_command("STATUS $box (". (join(" ",@_)||'MESSAGES'). ")") or return undef;
return wantarray ? $self->History($self->Count) :
[map{$_->[DATA]}@{$self->{'History'}{$self->Count}}];
}
# Can take a list of messages now.
# If a single message, returns array or ref to array of flags
# If a ref to array of messages, returns a ref to hash of msgid => flag arr
# See parse_headers for more information
# 2000-03-22 Adrian Smith (adrian.smith@ucpag.com)
sub flags {
my $self = shift;
my $msgspec = shift;
my $flagset = {};
my $msg;
my $u_f = $self->Uid;
# Determine if set of messages or just one
if (ref($msgspec) eq 'ARRAY') {
$msg = join(',', @$msgspec);
} else {
$msg = $msgspec;
if ( scalar(@_) ) {
$msg .= join(",",@_) ;
$msgspec = [ $msgspec, @_ ] ;
}
}
# Send command
unless ( $self->fetch($msg,"FLAGS") ) {
return undef;
}
# Parse results, setting entry in result hash for each line
foreach my $resultline ($self->Results) {
if ( $resultline =~
/ \*\s+(\d+)\s+FETCH\s+ # * nnn FETCH
\( # (
(?:\s?UID\s(\d+)\s?)? # optional: UID nnn <space>
FLAGS\s?\((.*)\)\s? # FLAGS (\Flag1 \Flag2) <space>
(?:\s?UID\s(\d+))? # optional: UID nnn
\) # )
/x
) {
$self->_debug("flags: line = '$resultline' and 1,2,3,4 = $1,$2,$3,$4\n")
if $self->Debug;
my $mailid = $u_f ? ( $2||$4) : $1;
my $flagsString = $3 ;
my @flags = map { s/\s+$//; $_ } split(/\s+/, $flagsString);
$flagset->{$mailid} = \@flags;
}
}
# Did the guy want just one response? Return it if so
if (ref($msgspec) ne 'ARRAY') {
my $flagsref = $flagset->{$msgspec};
return wantarray ? @$flagsref : $flagsref;
}
# Or did he want a hash from msgid to flag array?
return $flagset;
}
# parse_headers modified to allow second param to also be a
# reference to a list of numbers. If this is a case, the headers
# are read from all the specified messages, and a reference to
# an hash of mail numbers to references to hashes, are returned.
# I found, with a mailbox of 300 messages, this was
# *significantly* faster against our mailserver (< 1 second
# vs. 20 seconds)
#
# 2000-03-22 Adrian Smith (adrian.smith@ucpag.com)
sub parse_headers {
my($self,$msgspec,@fields) = @_;
my(%fieldmap) = map { ( lc($_),$_ ) } @fields;
my $msg; my $string; my $field;
# Make $msg a comma separated list, of messages we want
if (ref($msgspec) eq 'ARRAY') {
$msg = join(',', @$msgspec);
} else {
$msg = $msgspec;
}
if ($fields[0] =~ /^[Aa][Ll]{2}$/ ) {
$string = "$msg body" .
# use ".peek" if Peek parameter is a) defined and true,
# or b) undefined, but not if it's defined and untrue:
( defined($self->Peek) ?
( $self->Peek ? ".peek" : "" ) :
".peek"
) . "[header]" ;
} else {
$string = "$msg body" .
# use ".peek" if Peek parameter is a) defined and true, or
# b) undefined, but not if it's defined and untrue:
( defined($self->Peek) ?
( $self->Peek ? ".peek" : "" ) :
".peek"
) . "[header.fields (" . join(" ",@fields) . ')]' ;
}
my @raw=$self->fetch( $string ) or return undef;
my $headers = {}; # hash from message ids to header hash
my $h = 0; # reference to hash of current msgid, or 0 between msgs
for my $header (map { split(/(?:\x0d\x0a)/,$_) } @raw) {
local($^W) = undef;
if ( $header =~ /^\*\s+\d+\s+FETCH\s+\(.*BODY\[HEADER(?:\]|\.FIELDS)/i) {
if ($self->Uid) {
if ( my($msgid) = $header =~ /UID\s+(\d+)/ ) {
$h = {};
$headers->{$msgid} = $h;
} else {
$h = {};
}
} else {
if ( my($msgid) = $header =~ /^\*\s+(\d+)/ ) {
#start of new message header:
$h = {};
$headers->{$msgid} = $h;
}
}
}
# my $pattern = $self->Uid ? 'UID\\s+(\\d+)' : '^\\*\\s(\\d+)' ;
# if ( my($msgid) = $header =~ /$pattern/
# and $header =~ /BODY\[HEADER(?:\]|\.FIELDS)/i
# ) {
# # start of new message header:
# $h = {}; # new hash for headers for this mail
# $headers->{$msgid} = $h; # store in results, against this message
# }
next if $header =~ /^\s+$/;
# ( for vi
if ($header =~ /^\)/) { # end of this message
$h = 0; # set to be between messages
next;
}
# check for '<optional_white_space>UID<white_space><UID_number><optional_white_space>)'
# when parsing headers by UID.
if ($self->Uid and my($msgid) = $header =~ /^\s*UID\s+(\d+)\s*\)/) {
$headers->{$msgid} = $h; # store in results against this message
$h = 0; # set to be between messages
next;
}
if ($h != 0) { # do we expect this to be a header?
my $hdr = $header;
chomp $hdr;
$hdr =~ s/\r$//;
if ($hdr =~ s/^(\S+):\s*//) {
$field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ;
push @{$h->{$field}} , $hdr ;
} elsif ($hdr =~ s/^.*FETCH\s\(.*BODY\[HEADER\.FIELDS.*\)\]\s(\S+):\s*//) {
$field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ;
push @{$h->{$field}} , $hdr ;
} elsif ( ref($h->{$field}) eq 'ARRAY') {
$hdr =~ s/^\s+/ /;
$h->{$field}[-1] .= $hdr ;
}
}
}
my $candump = 0;
if ($self->Debug) {
eval {
require Data::Dumper;
Data::Dumper->import;
};
$candump++ unless $@;
}
# if we asked for one message, just return its hash,
# otherwise, return hash of numbers => header hash
if (ref($msgspec) eq 'ARRAY') {
#_debug $self,"Structure from parse_headers:\n",
# Dumper($headers)
# if $self->Debug;
return $headers;
} else {
#_debug $self, "Structure from parse_headers:\n",
# Dumper($headers->{$msgspec})
# if $self->Debug;
return $headers->{$msgspec};
}
}
sub parse_headers2 {
my($self,$msgspec,@fields) = @_;
my(%fieldmap) = map { ( lc($_),$_ ) } @fields;
my $msg; my $string; my $field;
# Make $msg a comma separated list, of messages we want
if (ref($msgspec) eq 'ARRAY') {
$msg = join(',', @$msgspec);
} else {
$msg = $msgspec;
}
if ($fields[0] =~ /^[Aa][Ll]{2}$/ ) {
$string = "$msg body" .
# use ".peek" if Peek parameter is a) defined and true,
# or b) undefined, but not if it's defined and untrue:
( defined($self->Peek) ?
( $self->Peek ? ".peek" : "" ) :
".peek"
) . "[header]" ;
} else {
$string = "$msg body" .
# use ".peek" if Peek parameter is a) defined and true, or
# b) undefined, but not if it's defined and untrue:
( defined($self->Peek) ?
( $self->Peek ? ".peek" : "" ) :
".peek"
) . "[header.fields (" . join(" ",@fields) . ')]' ;
}
my @raw=$self->fetch( $string ) or return undef;
my $headers = {}; # hash from message ids to header hash
my $h = 0; # reference to hash of current msgid, or 0 between msgs
for my $header (map { split(/(?:\x0d\x0a)/,$_) } @raw) {
local($^W) = undef;
my $pattern = $self->Uid ? 'UID\\s+(\\d+)' : '^\\*\\s(\\d+)' ;
if ( my($msgid) = $header =~ /$pattern/
and $header =~ /BODY\[HEADER(?:\]|\.FIELDS)/i
) {
# start of new message header:
$h = {}; # new hash for headers for this mail
$headers->{$msgid} = $h; # store in results, against this message
}
next if $header =~ /^\s+$/;
# ( for vi
if ($header =~ /^\)/) { # end of this message
$h = 0; # set to be between messages
next;
}
if ($h != 0) { # do we expect this to be a header?
my $hdr = $header;
chomp $hdr;
$hdr =~ s/\r$//;
if ($hdr =~ s/^(\S+): //) {
$field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ;
push @{$h->{$field}} , $hdr ;
} elsif ($hdr =~ s/^.*FETCH\s\(.*BODY\[HEADER\.FIELDS.*\)\]\s(\S+): //) {
$field = exists $fieldmap{lc($1)} ? $fieldmap{lc($1)} : $1 ;
push @{$h->{$field}} , $hdr ;
} elsif ( ref($h->{$field}) eq 'ARRAY') {
$hdr =~ s/^\s+/ /;
$h->{$field}[-1] .= $hdr ;
}
}
}
my $candump = 0;
if ($self->Debug) {
eval {
require Data::Dumper;
Data::Dumper->import;
};
$candump++ unless $@;
}
# if we asked for one message, just return its hash,
# otherwise, return hash of numbers => header hash
if (ref($msgspec) eq 'ARRAY') {
#_debug $self,"Structure from parse_headers:\n",
# Dumper($headers)
# if $self->Debug;
return $headers;
} else {
#_debug $self, "Structure from parse_headers:\n",
# Dumper($headers->{$msgspec})
# if $self->Debug;
return $headers->{$msgspec};
}
}
sub recent_count {
my ($self, $folder) = (shift, shift);
$self->status($folder, 'RECENT') or return undef;
chomp(my $r = ( grep { s/\*\s+STATUS\s+.*\(RECENT\s+(\d+)\s*\)/$1/ }
$self->History($self->Transaction)
)[0]);
$r =~ s/\D//g;
return $r;
}
sub message_count {
my ($self, $folder) = (shift, shift);
$folder ||= $self->Folder;
$self->status($folder, 'MESSAGES') or return undef;
foreach my $result (@{$self->{"History"}{$self->Transaction}}) {
return $1 if $result->[DATA] =~ /\(MESSAGES\s+(\d+)\s*\)/ ;
}
return undef;
}
{
for my $datum (
qw( recent seen
unseen
)
) {
no strict 'refs';
*$datum = sub {
my $self = shift;
my @hits;
my $hits = $self->search("$datum")
or return undef;
return wantarray ? @$hits : $hits;
};
}
}
{
for my $datum (
qw( sentbefore sentsince senton
since before on
)
) {
no strict 'refs';
*$datum = sub {
my($self,$time) = (shift,shift);
my @hits; my $imapdate;
my @mnt = qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
if ( $time =~ /\d\d-\D\D\D-\d\d\d\d/ ) {
$imapdate = $time;
} elsif ( $time =~ /^\d+$/ ) {
my @ltime = localtime($time);
$imapdate = sprintf( "%2.2d-%s-%4.4d",
$ltime[3], $mnt[$ltime[4]], $ltime[5] + 1900);
} else {
$self->LastError("Invalid date format supplied to '$datum' method.");
return undef;
}
$self->_imap_command( ($self->Uid ? "UID " : "") . "SEARCH $datum $imapdate")
or return undef;
my @results = $self->History($self->Count) ;
for my $r (@results) {
chomp $r;
$r =~ s/\r$//;
$r =~ s/^\*\s+SEARCH\s+//i or next;
push @hits, grep(/\d/,(split(/\s+/,$r)));
_debug $self, "Hits are now: ",join(',',@hits),"\n" if $self->Debug;
}
return wantarray ? @hits : \@hits;
}
}
}
#sub Strip_cr {
# my $self = shift;
# my $in = $_[0]||$self ;
# $in =~ s/\r//g ;
# return $in;
#}
sub disconnect { $_[0]->logout }
sub search {
my $self = shift;
my @hits;
my @a = @_;
$a[-1] = $self->Massage($a[-1]) if scalar(@a) > 1; # massage
$self->_imap_command( ( $self->Uid ? "UID " : "" ) . "SEARCH ". join(' ',@a))
or return wantarray ? @hits : \@hits ;
my @results = $self->History($self->Count) ;
for my $r (@results) {
chomp $r;
$r =~ s/\r$//;
$r =~ s/^\*\s+SEARCH\s+// or next;
push @hits, grep(/\d/,(split(/\s+/,$r)));
}
return wantarray ? @hits : \@hits;
}
sub delete_message {
my $self = shift;
my $count = 0;
my @msgs = ();
for my $arg (@_) {
if (ref($arg) eq 'ARRAY') {
push @msgs, @{$arg};
} else {
push @msgs, split(/\,/,$arg);
}
}
$self->store(join(',',@msgs),'+FLAGS.SILENT','(\Deleted)') and $count = scalar(@msgs);
return $count;
}
sub restore_message {
my $self = shift;
my @msgs = ();
for my $arg (@_) {
if (ref($arg) eq 'ARRAY') {
push @msgs, @{$arg};
} else {
push @msgs, split(/\,/,$arg);
}
}
$self->store(join(',',@msgs),'-FLAGS','(\Deleted)') ;
my $count = grep(
/
^\* # Start with an asterisk
\s\d+ # then a space then a number
\sFETCH # then a space then the string 'FETCH'
\s\( # then a space then an open paren :-)
.* # plus optional anything
FLAGS # then the string "FLAGS"
.* # plus anything else
(?!\\Deleted) # but never "\Deleted"
/x,
$self->Results
);
return $count;
}
sub uidvalidity {
my $self = shift; my $folder = shift;
my $vline = (grep(/UIDVALIDITY/i, $self->status($folder, "UIDVALIDITY")))[0];
my($validity) = $vline =~ /\(UIDVALIDITY\s+([^\)]+)/;
return $validity;
}
# 3 status folder (uidnext)
# * STATUS folder (UIDNEXT 290)
sub uidnext {
my $self = shift; my $folder = $self->Massage(shift);
my $line = (grep(/UIDNEXT/i, $self->status($folder, "UIDNEXT")))[0];
my($uidnext) = $line =~ /\(UIDNEXT\s+([^\)]+)/;
return $uidnext;
}
sub capability {
my $self = shift;
$self->_imap_command('CAPABILITY') or return undef;
my @caps = map { split } grep (s/^\*\s+CAPABILITY\s+//, $self->History($self->Count));
for (@caps) { $self->{CAPABILITY}{uc($_)}++}
return wantarray ? @caps : \@caps;
}
sub has_capability {
my $self = shift;
$self->capability;
return $self->{CAPABILITY}{uc($_[0])};
}
sub imap4rev1 {
my $self = shift;
return exists($self->{_IMAP4REV1}) ?
$self->{_IMAP4REV1} :
$self->{_IMAP4REV1} = $self->has_capability(IMAP4REV1) ;
}
sub namespace {
# Returns a (reference to a?) nested list as follows:
# [
# [
# [ $user_prefix, $user_delim ] ( , [ $user_prefix2, $user_delim] , [etc, etc] ) ,
# ],
# [
# [ $shared_prefix, $shared_delim ] ( , [ $shared_prefix2, $shared_delim] , [etc, etc] ) ,
# ],
# [
# [ $public_prefix, $public_delim ] ( , [ $public_prefix2, $public_delim] , [etc, etc] ) ,
# ],
# ] ;
my $self = shift;
unless ( $self->has_capability("NAMESPACE") ) {
my $error = $self->Count . " NO NAMESPACE not supported by " . $self->Server ;
$self->LastError("$error\n") ;
$@ = $error;
carp "$@" if $^W;
}
my $namespace = (map({ /^\* NAMESPACE (.*)/ ? $1 : () } @{$self->_imap_command("NAMESPACE")->Results}))[0] ;
$namespace =~ s/\x0d?\x0a$//;
my($personal,$shared,$public) = $namespace =~ m#
(NIL|\((?:\([^\)]+\)\s*)+\))\s
(NIL|\((?:\([^\)]+\)\s*)+\))\s
(NIL|\((?:\([^\)]+\)\s*)+\))
#xi;
my @ns = ();
$self->_debug("NAMESPACE: pers=$personal, shared=$shared, pub=$public\n");
push @ns, map {
$_ =~ s/^\((.*)\)$/$1/;
my @pieces = m#\(([^\)]*)\)#g;
$self->_debug("NAMESPACE pieces: " . join(", ",@pieces) . "\n");
my $ref = [];
foreach my $atom (@pieces) {
push @$ref, [ $atom =~ m#"([^"]*)"\s*#g ] ;
}
$_ =~ /^NIL$/i ? undef : $ref;
} ( $personal, $shared, $public) ;
return wantarray ? @ns : \@ns;
}
# Contributed by jwm3
sub internaldate {
my $self = shift;
my $msg = shift;
$self->_imap_command( ( $self->Uid ? "UID " : "" ) . "FETCH $msg INTERNALDATE") or return undef;
my $internalDate = join("", $self->History($self->Count));
$internalDate =~ s/^.*INTERNALDATE "//si;
$internalDate =~ s/\"\).*$//s;
return $internalDate;
}
sub is_parent {
my ($self, $folder) = (shift, shift);
# $self->_debug("Checking parentage " . ( $folder ? "for folder $folder" : "" ) . "\n");
my $list = $self->list(undef, $folder);
my $line;
for (my $m = 0; $m < scalar(@$list); $m++ ) {
#$self->_debug("Judging whether or not $list->[$m] is fit for parenthood\n");
return undef if $list->[$m] =~ /NoInferior/i; # let's not beat around the bush
if ($list->[$m] =~ s/(\{\d+\})\x0d\x0a$// ) {
$list->[$m] .= $list->[$m+1];
$list->[$m+1] = "";
}
$line = $list->[$m]
if $list->[$m] =~
/ ^\*\s+LIST # * LIST
\s+\([^\)]*\)\s+ # (Flags)
"[^"]*"\s+ # "delimiter"
(?:"([^"]*)"|(.*))\x0d\x0a$ # Name or "Folder name"
/x;
}
my($f) = $line =~ /^\*\s+LIST\s+\(([^\)]*)\s*\)/ if $line;
return 1 if $f =~ /HasChildren/i ;
return 0 if $f =~ /HasNoChildren/i ;
unless ( $f =~ /\\/) { # no flags at all unless there's a backslash
my $sep = $self->separator($folder);
return 1 if scalar(grep /^$folder$sep/, $self->folders);
return 0;
}
}
sub append_string {
my $self = shift;
my $folder = $self->Massage(shift);
my $text = shift;
$text =~ s/\x0d?\x0a/\x0d\x0a/g;
my($flags,$date) = (shift,shift);
if (defined($flags)) {
$flags =~ s/^\s+//g;
$flags =~ s/\s+$//g;
}
if (defined($date)) {
$date =~ s/^\s+//g;
$date =~ s/\s+$//g;
}
$flags = "($flags)" if $flags and $flags !~ /^\(.*\)$/ ;
my $clear = $self->Clear;
$self->Clear($clear)
if $self->Count >= $clear and $clear > 0;
my $count = $self->Count($self->Count+1);
my $string = "$count APPEND $folder " .
( $flags ? "$flags " : "" ) .
( $date ? "$date " : "" ) .
"{" . length($text) . "}\x0d\x0a" ;
$self->_record($count,[ $self->_next_index($count), "INPUT", "$string\x0d\x0a" ] );
# Step 1: Send the append command.
my $feedback = $self->_send_line("$string");
unless ($feedback) {
$self->LastError("Error sending '$string' to IMAP: $!\n");
return undef;
}
my ($code, $output) = ("","");
# Step 2: Get the "+ go ahead" response
until ( $code ) {
$output = $self->_read_line or return undef;
foreach my $o (@$output) {
$self->_record($count,$o); # $o is already an array ref
next unless $self->_is_output($o);
($code) = $o->[DATA] =~ /(^\+|^\d*\s*NO|^\d*\s*BAD)/i ;
if ($o->[DATA] =~ /^\*\s+BYE/i) {
$self->LastError("Error trying to append string: " .
$o->[DATA]. "; Disconnected.\n");
$self->_debug("Error trying to append string: " . $o->[DATA].
"; Disconnected.\n");
carp("Error trying to append string: " . $o->[DATA] ."; Disconnected") if $^W;
$self->State(Unconnected);
} elsif ( $o->[DATA] =~ /^\d*\s*(NO|BAD)/i ) { # i and / transposed!!!
$self->LastError("Error trying to append string: " . $o->[DATA] . "\n");
$self->_debug("Error trying to append string: " . $o->[DATA] . "\n");
carp("Error trying to append string: " . $o->[DATA]) if $^W;
return undef;
}
}
}
$self->_record($count,[ $self->_next_index($count), "INPUT", "$text\x0d\x0a" ] );
# Step 3: Send the actual text of the message:
$feedback = $self->_send_line("$text\x0d\x0a");
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
return undef;
}
$code = undef; # clear out code
# Step 4: Figure out the results:
until ($code) {
$output = $self->_read_line or return undef;
$self->_debug("Append results: " . map({ $_->[DATA] } @$output) . "\n" )
if $self->Debug;
foreach my $o (@$output) {
$self->_record($count,$o); # $o is already an array ref
($code) = $o->[DATA] =~ /^(?:$count|\*) (OK|NO|BAD)/im ;
if ($o->[DATA] =~ /^\*\s+BYE/im) {
$self->State(Unconnected);
$self->LastError("Error trying to append: " . $o->[DATA] . "\n");
$self->_debug("Error trying to append: " . $o->[DATA] . "\n");
carp("Error trying to append: " . $o->[DATA] ) if $^W;
}
if ($code and $code !~ /^OK/im) {
$self->LastError("Error trying to append: " . $o->[DATA] . "\n");
$self->_debug("Error trying to append: " . $o->[DATA] . "\n");
carp("Error trying to append: " . $o->[DATA] ) if $^W;
return undef;
}
}
}
my($uid) = join("",map { $_->[TYPE] eq "OUTPUT" ? $_->[DATA] : () } @$output ) =~ m#\s+(\d+)\]#;
return defined($uid) ? $uid : $self;
}
sub append {
my $self = shift;
# now that we're passing thru to append_string we won't massage here
# my $folder = $self->Massage(shift);
my $folder = shift;
my $text = join("\x0d\x0a",@_);
$text =~ s/\x0d?\x0a/\x0d\x0a/g;
return $self->append_string($folder,$text);
}
=begin legacy
my $clear = $self->Clear;
$self->Clear($clear)
if $self->Count >= $clear and $clear > 0;
my $count = $self->Count($self->Count+1);
my $string = "$count APPEND $folder {" . length($text) . "}\x0d\x0a" ;
$self->_record($count,[ $self->_next_index($count), "INPUT", "$string\x0d\x0a" ] );
# Step 1: Send the append command.
my $feedback = $self->_send_line("$string");
unless ($feedback) {
$self->LastError("Error sending '$string' to IMAP: $!\n");
return undef;
}
my ($code, $output) = ("","");
# Step 2: Get the "+ go ahead" response
until ( $code ) {
$output = $self->_read_line or return undef;
foreach my $o (@$output) {
$self->_record($count,$o); # $o is already an array ref
next unless $self->_is_output($o);
($code) = $o->[DATA] =~ /(^\+|^\d*\s*NO|^\d*\s*BAD)/i ;
if ($o->[DATA] =~ /^\*\s+BYE/i) {
$self->LastError("Error trying to append: " . $o->[DATA]. "; Disconnected.\n");
$self->_debug("Error trying to append: " . $o->[DATA]. "; Disconnected.\n");
carp("Error trying to append: " . $o->[DATA] ."; Disconnected") if $^W;
$self->State(Unconnected);
} elsif ( $o->[DATA] =~ /^\d*\s*(NO|BAD)/i ) { # i and / transposed!!!
$self->LastError("Error trying to append: " . $o->[DATA] . "\n");
$self->_debug("Error trying to append: " . $o->[DATA] . "\n");
carp("Error trying to append: " . $o->[DATA]) if $^W;
return undef;
}
}
}
$self->_record($count,[ $self->_next_index($count), "INPUT", "$text\x0d\x0a" ] );
# Step 3: Send the actual text of the message:
$feedback = $self->_send_line("$text\x0d\x0a");
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
return undef;
}
$code = undef; # clear out code
# Step 4: Figure out the results:
until ($code) {
$output = $self->_read_line or return undef;
$self->_debug("Append results: " . map({ $_->[DATA] } @$output) . "\n" )
if $self->Debug;
foreach my $o (@$output) {
$self->_record($count,$o); # $o is already an array ref
($code) = $o->[DATA] =~ /^(?:$count|\*) (OK|NO|BAD)/im ;
if ($o->[DATA] =~ /^\*\s+BYE/im) {
$self->State(Unconnected);
$self->LastError("Error trying to append: " . $o->[DATA] . "\n");
$self->_debug("Error trying to append: " . $o->[DATA] . "\n");
carp("Error trying to append: " . $o->[DATA] ) if $^W;
}
if ($code and $code !~ /^OK/im) {
$self->LastError("Error trying to append: " . $o->[DATA] . "\n");
$self->_debug("Error trying to append: " . $o->[DATA] . "\n");
carp("Error trying to append: " . $o->[DATA] ) if $^W;
return undef;
}
}
}
my($uid) = join("",map { $_->[TYPE] eq "OUTPUT" ? $_->[DATA] : () } @$output ) =~ m#\s+(\d+)\]#;
return defined($uid) ? $uid : $self;
}
=end legacy
=cut
sub append_file {
my $self = shift;
my $folder = $self->Massage(shift);
my $file = shift;
my $control = shift || undef;
my $count = $self->Count($self->Count+1);
unless ( -f $file ) {
$self->LastError("File $file not found.\n");
return undef;
}
my $fh = IO::File->new($file) ;
unless ($fh) {
$self->LastError("Unable to open $file: $!\n");
$@ = "Unable to open $file: $!" ;
carp "unable to open $file: $!" if $^W;
return undef;
}
my $bare_nl_count = scalar grep { /^\x0a$|[^\x0d]\x0a$/} <$fh>;
seek($fh,0,0);
my $clear = $self->Clear;
$self->Clear($clear)
if $self->Count >= $clear and $clear > 0;
my $length = ( -s $file ) + $bare_nl_count;
my $string = "$count APPEND $folder {" . $length . "}\x0d\x0a" ;
$self->_record($count,[ $self->_next_index($count), "INPUT", "$string" ] );
my $feedback = $self->_send_line("$string");
unless ($feedback) {
$self->LastError("Error sending '$string' to IMAP: $!\n");
close $fh;
return undef;
}
my ($code, $output) = ("","");
until ( $code ) {
$output = $self->_read_line or close $fh, return undef;
foreach my $o (@$output) {
$self->_record($count,$o); # $o is already an array ref
($code) = $o->[DATA] =~ /(^\+|^\d+\sNO|^\d+\sBAD)/i;
if ($o->[DATA] =~ /^\*\s+BYE/) {
carp $o->[DATA] if $^W;
$self->State(Unconnected);
close $fh;
return undef ;
} elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
carp $o->[DATA] if $^W;
close $fh;
return undef;
}
}
}
{ # Narrow scope
# Slurp up headers: later we'll make this more efficient I guess
local $/ = "\x0d\x0a\x0d\x0a";
my $text = <$fh>;
$text =~ s/\x0d?\x0a/\x0d\x0a/g;
$self->_record($count,[ $self->_next_index($count), "INPUT", "{From file $file}" ] ) ;
$feedback = $self->_send_line($text);
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
close $fh;
return undef;
}
_debug $self, "control points to $$control\n" if ref($control) and $self->Debug;
$/ = ref($control) ? "\x0a" : $control ? $control : "\x0a";
while (defined($text = <$fh>)) {
$text =~ s/\x0d?\x0a/\x0d\x0a/g;
$self->_record( $count,
[ $self->_next_index($count), "INPUT", "{from $file}\x0d\x0a" ]
);
$feedback = $self->_send_line($text,1);
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
close $fh;
return undef;
}
}
$feedback = $self->_send_line("\x0d\x0a");
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
close $fh;
return undef;
}
}
# Now for the crucial test: Did the append work or not?
($code, $output) = ("","");
my $uid = undef;
until ( $code ) {
$output = $self->_read_line or return undef;
foreach my $o (@$output) {
$self->_record($count,$o); # $o is already an array ref
$self->_debug("append_file: Deciding if " . $o->[DATA] . " has the code.\n")
if $self->Debug;
($code) = $o->[DATA] =~ /^\d+\s(NO|BAD|OK)/i;
# try to grab new msg's uid from o/p
$o->[DATA] =~ m#UID\s+\d+\s+(\d+)\]# and $uid = $1;
if ($o->[DATA] =~ /^\*\s+BYE/) {
carp $o->[DATA] if $^W;
$self->State(Unconnected);
close $fh;
return undef ;
} elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
carp $o->[DATA] if $^W;
close $fh;
return undef;
}
}
}
close $fh;
if ($code !~ /^OK/i) {
return undef;
}
return defined($uid) ? $uid : $self;
}
sub authenticate {
my $self = shift;
my $scheme = shift;
my $response = shift;
my $clear = $self->Clear;
$self->Clear($clear)
if $self->Count >= $clear and $clear > 0;
my $count = $self->Count($self->Count+1);
my $string = "$count AUTHENTICATE $scheme";
$self->_record($count,[ $self->_next_index($self->Transaction), "INPUT", "$string\x0d\x0a"] );
my $feedback = $self->_send_line("$string");
unless ($feedback) {
$self->LastError("Error sending '$string' to IMAP: $!\n");
return undef;
}
my ($code, $output);
until ($code) {
$output = $self->_read_line or return undef;
foreach my $o (@$output) {
$self->_record($count,$o); # $o is a ref
($code) = $o->[DATA] =~ /^\+ (.*)$/ ;
if ($o->[DATA] =~ /^\*\s+BYE/) {
$self->State(Unconnected);
return undef ;
}
}
}
return undef if $code =~ /^BAD|^NO/ ;
$feedback = $self->_send_line($response->($code));
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
return undef;
}
$code = ""; # clear code
until ($code) {
$output = $self->_read_line or return undef;
foreach my $o (@$output) {
$self->_record($count,$o); # $o is a ref
if ( ($code) = $o->[DATA] =~ /^\+ (.*)$/ ) {
$feedback = $self->_send_line($response->($code));
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
return undef;
}
$code = "" ; # Clear code; we're still not finished
} else {
$o->[DATA] =~ /^$count (OK|NO|BAD)/ and $code = $1;
if ($o->[DATA] =~ /^\*\s+BYE/) {
$self->State(Unconnected);
return undef ;
}
}
}
}
$code =~ /^OK/ and $self->State(Authenticated) ;
return $code =~ /^OK/ ? $self : undef ;
}
# UIDPLUS response from a copy: [COPYUID (uidvalidity) (origuid) (newuid)]
sub copy {
my($self, $target, @msgs) = @_;
$target = $self->Massage($target);
@msgs = sort { $a <=> $b } map { ref($_)? @$_ : split(',',$_) } @msgs;
$self->_imap_command(
( $self->Uid ? "UID " : "" ) .
"COPY " .
join(',',map { ref($_)? @$_ : $_ } @msgs) .
" $target"
) or return undef ;
my @results = $self->History($self->Count) ;
my @uids;
for my $r (@results) {
chomp $r;
$r =~ s/\r$//;
$r =~ s/^.*\[COPYUID\s+\d+\s+[\d:,]+\s+([\d:,]+)\].*/$1/ or next;
push @uids, ( $r =~ /(\d+):(\d+)/ ? $1 ... $2 : split(/,/,$r) ) ;
}
return scalar(@uids) ? join(",",@uids) : $self;
}
sub move {
my($self, $target, @msgs) = @_;
$self->create($target) and $self->subscribe($target)
unless $self->exists($target);
my $uids = $self->copy($target, map { ref($_) ? @{$_} : $_ } @msgs) or return undef;
$self->delete_message(@msgs);
return $uids;
}
sub set_flag {
my($self, $flag, @msgs) = @_;
if ( ref($msgs[0]) ) { @msgs = @{$msgs[0]} };
$flag =~ /^\\/ or $flag = "\\" . $flag
if $flag =~ /^(Answered|Flagged|Deleted|Seen|Draft)$/i;
$self->store( join(",",@msgs), "+FLAGS.SILENT (" . $flag . ")" );
}
sub see {
my($self, @msgs) = @_;
if ( ref($msgs[0]) ) { @msgs = @{$msgs[0]} };
$self->set_flag('\\Seen', @msgs);
}
sub mark {
my($self, @msgs) = @_;
if ( ref($msgs[0]) ) { @msgs = @{$msgs[0]} };
$self->set_flag('\\Flagged', @msgs);
}
sub unmark {
my($self, @msgs) = @_;
if ( ref($msgs[0]) ) { @msgs = @{$msgs[0]} };
$self->unset_flag('\\Flagged', @msgs);
}
sub unset_flag {
my($self, $flag, @msgs) = @_;
if ( ref($msgs[0]) ) { @msgs = @{$msgs[0]} };
$flag =~ /^\\/ or $flag = "\\" . $flag ;
$self->store( join(",",@msgs), "-FLAGS.SILENT (" . $flag . ")" );
}
sub deny_seeing {
my($self, @msgs) = @_;
if ( ref($msgs[0]) ) { @msgs = @{$msgs[0]} };
$self->unset_flag('\\Seen', @msgs);
}
sub size {
my ($self,$msg) = @_;
# return undef unless fetch is successful
my @data = $self->fetch($msg,"(RFC822.SIZE)");
return undef unless defined($data[0]);
my($size) = grep(/RFC822\.SIZE/,@data);
$size =~ /RFC822\.SIZE\s+(\d+)/;
return $1;
}
sub getquotaroot {
my $self = shift;
my $what = shift;
$what = ( $what ? $self->Massage($what) : "INBOX" ) ;
$self->_imap_command("getquotaroot $what") or return undef;
return $self->Results;
}
sub getquota {
my $self = shift;
my $what = shift;
$what = ( $what ? $self->Massage($what) : "user/$self->{User}" ) ;
$self->_imap_command("getquota $what") or return undef;
return $self->Results;
}
sub quota {
my $self = shift;
my ($what) = shift||"INBOX";
$self->_imap_command("getquota $what")||$self->getquotaroot("$what");
return ( map { s/.*STORAGE\s+\d+\s+(\d+).*\n$/$1/ ? $_ : () } $self->Results
)[0] ;
}
sub quota_usage {
my $self = shift;
my ($what) = shift||"INBOX";
$self->_imap_command("getquota $what")||$self->getquotaroot("$what");
return ( map { s/.*STORAGE\s+(\d+)\s+\d+.*\n$/$1/ ? $_ : () } $self->Results
)[0] ;
}
sub Massage {
my $self= shift;
my $arg = shift;
my $escaped_arg = $arg; $escaped_arg =~ s/"/\\"/g;
$arg = substr($arg,1,length($arg)-2) if $arg =~ /^".*"$/
and ! ( $self->STATUS(qq("$escaped_arg"),"(MESSAGES)"));
if ($arg =~ /["\\]/) {
$arg = "{" . length($arg) . "}\x0d\x0a$arg" ;
} else {
$arg = qq("${arg}") unless $arg =~ /^"/;
}
return $arg;
}
sub unseen_count {
my ($self, $folder) = (shift, shift);
$folder ||= $self->Folder;
$self->status($folder, 'UNSEEN') or return undef;
chomp( my $r = ( grep
{ s/\*\s+STATUS\s+.*\(UNSEEN\s+(\d+)\s*\)/$1/ }
$self->History($self->Transaction)
)[0]
);
$r =~ s/\D//g;
return $r;
}
# Status Routines:
sub Status { $_[0]->State ; }
sub IsUnconnected { ($_[0]->State == Unconnected) ? 1 : 0 ; }
sub IsConnected { ($_[0]->State >= Connected) ? 1 : 0 ; }
sub IsAuthenticated { ($_[0]->State >= Authenticated)? 1 : 0 ; }
sub IsSelected { ($_[0]->State == Selected) ? 1 : 0 ; }
# The following private methods all work on an output line array.
# _data returns the data portion of an output array:
sub _data { $_[1]->[DATA]; }
# _index returns the index portion of an output array:
sub _index { $_[1]->[INDEX]; }
# _type returns the type portion of an output array:
sub _type { $_[1]->[TYPE]; }
# _is_literal returns true if this is a literal:
sub _is_literal { defined $_[1] and defined $_[1]->[TYPE] and $_[1]->[TYPE] eq "LITERAL" };
# _is_output_or_literal returns true if this is an
# output line (or the literal part of one):
sub _is_output_or_literal {
defined $_[1] and defined $_[1]->[TYPE] and
($_[1]->[TYPE] eq "OUTPUT" || $_[1]->[TYPE] eq "LITERAL")
};
# _is_output returns true if this is an output line:
sub _is_output { defined $_[1] and defined $_[1]->[TYPE] and $_[1]->[TYPE] eq "OUTPUT" };
# _is_input returns true if this is an input line:
sub _is_input { defined $_[1] and defined $_[1]->[TYPE] and $_[1]->[TYPE] eq "INPUT" };
# _next_index returns next_index for a transaction; may legitimately return 0 when successful.
sub _next_index {
defined(scalar(@{$_[0]->{'History'}{$_[1]||$_[0]->Transaction}})) ?
scalar(@{$_[0]->{'History'}{$_[1]||$_[0]->Transaction}}) : 0
};
=head1 SYNOPSIS
use Mail::IMAPClient;
my $imap = Mail::IMAPClient->new( Server => 'imaphost',
User => 'memememe',
Password => 'secret',
);
$imap->Debug($opt_d);
my @folders = $imap->folders;
foreach my $f (@folders) {
print "$f is a folder with ",
$imap->message_count($f),
" messages.\n";
}
=cut
=head1 DESCRIPTION
This module provides methods implementing the IMAP protocol. It allows perl scripts
to interact with IMAP message stores.
The module is used by constructing or instantiating a new IMAPClient object via the
B<new> constructor method. Once the object has been instantiated, the B<connect> method is
either implicitly or explicitly called. At that point methods are available that implement the
IMAP client commands as specified in I<RFC2060>. When processing is complete, the I<logoff> object
method is called, either explicitly by the program or implicitly when the object goes out of scope
(or at program termination).
This documentation is not meant to be a replacement for RFC2060, and the wily programmer will
have a copy of that document handy when coding IMAP clients.
Note that this documentation uses the term I<folder> in place of RFC2060's use of I<mailbox>.
This documentation reserves the use of the term I<mailbox> to refer to the set of folders owned
by a specific IMAP id.
RFC2060 defines four possible states for an IMAP connection: not authenticated, authenticated,
selected, and logged out. These correspond to the B<IMAPClient> constants B<Connected>,
B<Authenticated>, B<Selected>, and B<Unconnected>, respectively. These constants are
implemented as class methods, and can be used in conjunction with the B<Status> method to
determine the status of an B<IMAPClient> object and its underlying IMAP session. Note that an
B<IMAPClient> object can be in the B<Unconnected> state both before a server connection is made
and after it has ended. This differs slightly from RFC2060, which does not define a
pre-connection status. For a discussion of the methods available for examining the B<IMAPClient>
object's status, see the section labeled "Status Methods", below.
=head2 Errors
If you attempt an operation that results in an error, then you can retrieve the text of the error
message by using the B<LastError> method. However, since the B<LastError> method is an object method
(and not a class method) you will only be able to use this method if you've successfully created your
object. Errors in the B<new> method can prevent your object from ever being created. Additionally, if
you supply the I<Server>, I<User>, and I<Password> parameters to B<new>, it will attempt to call
B<connect> and B<login>, either of which could fail and cause your B<new> method call to return undef
(in which case your object will have been created but its reference will have been discarded before
ever being returned to you).
If this happens to you, you can always check C<$@>. B<Mail::IMAPClient> will populate that variable with
something useful if either of the B<new>, B<connect>, or B<login> methods fail. In fact, as of version
2, the C<$@> variable will always contain error info from the last error, so you can print that instead
of calling B<LastError> if you wish.
If you run your script with warnings turned on (which I'm sure you'll do at some point because it's
such a good idea) then any error message that gets placed into the I<LastError> slot (and/or in C<$@>)
will automatically generate a warning.
=head2 Transactions
RFC2060 requires that each line in an IMAP conversation be prefixed with a tag. A typical
conversation consists of the client issuing a tag-prefixed command string, and the server
replying with one of more lines of output. Those lines of output will include a
command completion status code prefixed by the same tag as the original command string.
The B<IMAPClient> module uses a simple counter to ensure that each client command is issued with
a unique tag value. This tag value is referred to by the B<IMAPClient> module as the transaction
number. A history is maintained by the B<IMAPClient> object documenting each transaction.
The B<Transaction> method returns the number of the last transaction, and can be used to
retrieve lines of text from the object's history.
The B<Clear> parameter is used to control the size of the session history so that long-running
sessions do not eat up unreasonable amounts of memory. See the discussion of B<Clear> under
L<"parameters"> for more information.
The B<Report> transaction returns the history of the entire IMAP session since the
initial connection or for the last I<Clear> transactions. This provides a record of the entire
conversation, including client command strings and server responses, and is a wonderful debugging tool
as well as a useful source of raw data for custom parsing.
=head2 Class Methods
There are a couple of methods that can be invoked as class methods. Generally they can be
invoked as an object method as well, as a convenience to the programmer. (That is, as a
convenience to the programmer who wrote this module, as well as the programmers using it.
It's easier I<not> to enforce a class method's classiness.) Note that if the B<new> method
is called as an object method, the object returned is identical to what have would been
returned if B<new> had been called as a class method. It doesn't give you a copy of the original
object or anything like that.
=over 4
=item new()
The B<new> method creates a new instance of an B<IMAPClient> object. If the I<Server> parameter
is passed as an argument to B<new>, then B<new> will implicitly call the B<connect> method, placing
the new object in the I<Connected> state. If I<User> and I<Password> values are also provided, then
B<connect> will in turn call B<login>, and the resulting object will be returned from B<new> in the
I<Authenticated> state.
If the I<Server> parameter is not supplied then the B<IMAPClient> object is created in the
I<Unconnected> state.
If the B<new> method is passed arguments then those arguments will be treated as a list of key=>value
pairs. The key should be one of the parameters as documented under L<"parameters">, below.
Here are some examples:
use Mail::IMAPClient;
my $imap = Mail::IMAPClient->new; # returns an unconnected Mail::IMAPClient object
# ... # intervening code using the 1st object, then:
$imap = Mail::IMAPClient->new( # returns a new, authenticated Mail::IMAPClient object
Server => $host,
User => $id,
Password=> $pass,
Clear => 5, # Unnecessary since '5' is the default
# ... # Other key=>value pairs go here
) or die "Cannot connect to $host as $id: $@";
See also L<"parameters">, below, and L<"connect"> and L<"login"> for information on how to manually
connect and login after B<new>.
=cut
=item Unconnected()
returns a value equal to the numerical value associated with an object in the B<Unconnected>
state.
=item Connected()
returns a value equal to the numerical value associated with an object in the B<Connected>
state.
=item Authenticated()
returns a value equal to the numerical value associated with an object in the B<Authenticated>
state.
=item Selected()
returns a value equal to the numerical value associated with an object in the B<Selected>
state.
=item Strip_cr()
The B<Strip_cr> method strips carriage returns from IMAP client command output. Although
RFC2060 specifies that lines in an IMAP conversation end with <CR><LF>, it is often cumbersome
to have the carriage returns in the returned data. This method accepts one or more lines of text as
arguments, and returns those lines with all <CR><LF> sequences changed to <LF>. Any input argument
with no carriage returns is returned unchanged. If the first argument (not counting the class name or
object reference) is an array reference, then members of that array are processed as above and subsequent
arguments are ignored. If the method is called in scalar context then an array reference is returned instead
of an array of results.
Taken together, these last two lines mean that you can do something like:
my @list = $imap->some_imap_method ;
@list = $imap->Strip_cr(@list) ;
# or:
my $list = [ $imap->some_imap_method ] ; # returns an array ref
$list = $imap->Strip_cr($list);
B<NOTE: Strip_cr> does not remove new line characters.
=cut
=item Rfc2060_date()
The B<Rfc2060_date> method accepts one input argument, a number of seconds since
the epoch date. It returns an RFC2060 compliant date string for that date
(as required in date-related arguments to SEARCH, such as "since", "before", etc.).
=item Rfc822_date()
The B<Rfc822_date> method accepts one input argument, a number of seconds since
the epoch date. It returns an RFC822 compliant date string for that date
(without the 'Date:' prefix). Useful for putting dates in message strings before
calling B<append>.
=back
=head2 Parameters
There are several parameters that influence the behavior of an B<IMAPClient> object. Each is
set by specifying a named value pair during new method invocation as follows:
my $imap = Mail::IMAPClient->new ( parameter => "value",
parameter2 => "value",
...
);
Parameters can also be set after an object has been instantiated by using the parameter's
eponymous accessor method like this:
my $imap = Mail::IMAPClient->new;
$imap->parameter( "value");
$imap->parameter2("value");
The eponymous accessor methods can also be used without arguments to obtain the current value
of the parameter as follows:
my $imap = Mail::IMAPClient->new;
$imap->parameter( "value");
$imap->parameter2("value");
... # A whole bunch of awesome perl code,
# omitted for brevity
my $forgot = $imap->parameter;
my $forgot2 = $imap->parameter2;
Note that in these examples I'm using 'parameter' and 'parameter2' as generic parameter names.
The B<IMAPClient> object doesn't actually have parameters named 'parameter' and 'parameter2'.
On the contrary, the available parameters are:
=over 4
=item Buffer()
The I<Buffer> parameter sets the size of a block of I/O. It is ignored unless I<Fast_io>, below,
is set to a true value. It's value should be the number of bytes to attempt to read in one I/O
operation. The default value is 4096.
=item Clear()
The name of this parameter, for historical reasons, is somewhat misleading. It should be named
I<Wrap>, because it specifies how many transactions are stored in the wrapped history buffer. But
it didn't always work that way; the buffer used to actually get cleared. The name though remains
the same in the interests of backwards compatibility.
I<Clear> specifies that the object's history buffer should be wrapped after every I<n> transactions,
where I<n> is the value specified for the I<Clear> parameter. Calling the eponymous B<Clear>
method without an argument will return the current value of the I<Clear> parameter but will not
cause clear the history buffer to wrap.
Setting I<Clear> to 0 turns off automatic history buffer wrapping, and setting it to 1
turns off the history buffer facility (except for the last transaction, which cannot be
disabled without breaking the B<IMAPClient> module). Setting I<Clear> to 0 will not cause an
immediate clearing of the history buffer; setting it to 1 (or any other number) will (except of
course for that inevitable last transaction).
The default I<Clear> value is set to five in order to conserve memory.
=item Debug()
Sets the debugging flag to either a true or false value. Can be supplied with the B<new>
method call or separately by calling the B<Debug> object method. Use of this parameter is
strongly recommended when debugging scripts and required when reporting bugs.
=item Debug_fh()
Specifies the filehandle to which debugging information should be printed. It can either a
filehandle object reference or a filehandle glob. The default is to print debugging info to
STDERR.
For example, you can:
use Mail::IMAPClient;
use IO::File;
# set $user, $pass, and $server here
my $dh = IO::File->new(">debugging.output")
or die "Can't open debugging.output: $!\n";
my $imap = Mail::IMAPClient->new( User=>$user, Password=>$pass,
Server=>$server, Debug=> "yes, please",
Debug_fh => $dh
);
Or you can:
use Mail::IMAPClient;
# set $user, $pass, and $server here
open(DBG,">debugging.output")
or die "Can't open debugging.output: $!\n";
my $imap = Mail::IMAPClient->new( User=>$user, Password=>$pass,
Server=>$server, Debug=> 1,
Debug_fh => *DBG
);
=item Folder()
The I<Folder> parameter returns the name of the currently-selected folder (in case you forgot).
It can also be used to set the name of the currently selected folder, which is completely unnecessary if
you used the B<select> method (or B<select>'s read-only equivalent, the B<examine> method) to select it.
Note that setting the I<Folder> parameter does not automatically select a new folder; you use the
B<select> or B<examine> object methods for that. Generally, the I<Folder> parameter should only be
queried (by using the no-argument form of the B<Folder> method). You will only need to set the I<Folder>
parameter if you use some mysterious technique of your own for selecting a folder, which you probably
won't do.
=cut
=item Maxtemperrors()
The I<Maxtemperrors> parameter specifies the number of times a write operation is allowed to fail on a
"Resource Temporarily Available" error. These errors can occur from time to time if the server is too
busy to empty out its read buffer (which is logically the "other end" of the client's write buffer). By
default, B<Mail::IMAPClient> will retry 10 times, but you can adjust this behavior by setting
I<Maxtemperrors>. Note that after each temporary error, the server will wait for a number of seconds
equal to the number of consecutive temporary errors times .25, so very high values for I<Maxtemperrors>
can slow you down in a big way if your "temporary error" is not all that temporary.
You can set this parameter to "UNLIMITED" to ignore "Resource Temporarily Unavailable" errors.
=item Password()
Specifies the password to use when logging into the IMAP service on the host specified in the
I<Server> parameter as the user specified in the I<User> parameter. Can be supplied with
the B<new> method call or separately by calling the B<Password> object method.
If I<Server>, I<User>, and I<Password> are all provided to the B<new> method, then the newly
instantiated object will be connected to the host specified in I<Server> (at either the port
specified in I<Port> or the default port 143) and then logged on as the user specified in
the I<User> parameter (using the password provided in the I<Password> parameter). See the
discussion of the B<new> method, below.
=item Peek()
Setting I<Peek> to a true value will prevent the B<body_string>, B<message_string> and B<message_to_file>
methods from automatically setting the I<\Seen> flag. Setting I<Peek> to 0 (zero) will force B<body_string>,
B<message_string>, B<message_to_file>, and B<parse_headers> to always set the I<\Seen> flag.
The default is to set the seen flag whenever you fetch the body of a message but not when you just fetch the
headers. Passing I<undef> to the eponymous B<Peek> method will reset the I<Peek> parameter to its pristine,
default state.
=cut
=item Port()
Specifies the port on which the IMAP server is listening. The default is 143, which is the
standard IMAP port. Can be supplied with the B<new> method call or separately by calling
the B<Port> object method.
=item Server()
Specifies the hostname or IP address of the host running the IMAP server. If provided as part
of the B<new> method call, then the new IMAP object will automatically be connected at the
time of instantiation. (See the B<new> method, below.) Can be supplied with the B<new>
method call or separately by calling the B<Server> object method.
=cut
=item Socket()
The I<Socket> method can be used to obtain the socket handle of the current connection (say, to
do I/O on the connection that is not otherwise supported by B<Mail::IMAPClient>) or to replace
the current socket with a new handle (perhaps an SSL handle, for example).
If you supply a socket handle yourself, either by doing something like:
$imap=Mail::IMAPClient->new(Socket=>$sock, User => ... );
or by doing something like:
$imap=Mail::IMAPClient->new(User => $user, Password => $pass, Server => $host);
# blah blah blah
$imap->Socket($ssl);
then it will be up to you to establish the connection AND to authenticate, either via the B<login>
method, or the fancier B<authenticate>, or, since you know so much anyway, by just doing raw I/O
against the socket until you're logged in. If you do any of this then you should also set the
I<State> parameter yourself to reflect the current state of the object (i.e. Connected,
Authenticated, etc).
=cut
=item Timeout()
Specifies the timeout value in seconds for reads. Specifying a true value for I<Timeout>
will prevent B<Mail::IMAPClient> from blocking in a read.
Since timeouts are implemented via the perl B<select> operator, the I<Timeout> parameter
may be set to a fractional number of seconds. Not supplying a I<Timeout>, or (re)setting it to
zero, disables the timeout feature.
=cut
=item Uid()
If I<Uid> is set to a true value (i.e. 1) then the behavior of the B<fetch>, B<search>, B<copy>,
and B<store> methods (and their derivatives) is changed so that arguments that would otherwise be
message sequence numbers are treated as message UID's and so that return values (in the case of the
B<search> method and its derivatives) that would normally be message sequence numbers are
instead message UID's.
Internally this is implemented as a switch that, if turned on, causes methods that would otherwise
issue an IMAP FETCH, STORE, SEARCH, or COPY client command to instead issue UID FETCH, UID STORE,
UID SEARCH, or UID COPY, respectively. The main difference between message sequence numbers and
message UID's is that, according to RFC2060, UID's must not change during a session and should not
change between sessions, and must never be reused. Sequence numbers do not have that same guarantee and
in fact may be reused right away.
Since foldernames also have a unique identifier (UIDVALIDITY), which is provided when the folder
is B<select>ed or B<examine>d or by doing something like "$imap->status($folder,"UIDVALIDITY"),
it is possible to uniquely identify every message on the server, although normally you won't need
to bother.
The methods currently affected by turning on the I<Uid> flag are:
copy fetch
search store
message_string message_uid
body_string flags
move size
parse_headers
Note that if for some reason you only want the I<Uid> parameter turned on for one command, then
you can choose between the following two snippets, which are equivalent:
Example 1:
$imap->Uid(1);
my @uids = $imap->search('SUBJECT',"Just a silly test"); #
$imap->Uid(0);
Example 2:
my @uids;
foreach $r ($imap->UID("SEARCH","SUBJECT","Just a silly test") {
chomp $r;
$r =~ s/\r$//;
$r =~ s/^\*\s+SEARCH\s+// or next;
push @uids, grep(/\d/,(split(/\s+/,$r)));
}
In the second example, we used the default method to issue the UID IMAP Client command, being
careful to use an all-uppercase method name so as not to inadvertently call the I<Uid> accessor method.
Then we parsed out the message UIDs manually, since we don't have the benefit of the built-in
B<search> method doing it for us.
Please be very careful when turning the I<Uid> parameter on and off throughout a script. If you loose
track of whether you've got the I<Uid> parameter turned on you might do something sad, like deleting
the wrong message. Remember, like all eponymous accessor methods, the B<Uid> method without arguments
will return the current value for the I<Uid> parameter, so do yourself a favor and check. The safest
approach is probably to turn it on at the beginning and then leave it on. (Remember that leaving it
turned off can lead to problems if changes to a folder's contents cause resequencing.)
By default, the I<Uid> parameter is turned on.
=item User()
Specifies the userid to use when logging into the IMAP service. Can be supplied with the
B<new> method call or separately by calling the B<User> object method.
Parameters can be set during B<new> method invocation by passing named parameter/value pairs
to the method, or later by calling the parameter's eponymous object method.
=back
=cut
=head2 Object Methods
Object methods must be invoked against objects created via the B<new> method. They cannot be
invoked as class methods, which is why they are "object methods" and not "class methods".
There are basically two types of object methods--those that participate in the IMAP session's
conversation (i.e. they issue IMAP client commands) and those that do not. Methods that do
not result in new IMAP client commands being issued (such as the B<Transaction, Status>, and
B<History> methods) all begin with an uppercase letter, to distinguish themselves from methods
that do correspond to IMAP client commands. (Class methods and eponymous parameter methods
likewise begin with an uppercase letter because they also do not correspond to an IMAP client
command.)
The B<IMAPClient> object methods are:
=over 4
=item append()
The B<append> method adds a message to the specified folder. It takes two arguments, the
name of the folder to append the message to, and the text of the message (including headers).
Additional arguments are added to the message text, separated with <CR><LF>.
The B<append> method returns the UID of the new message (a true value) if successful,
or undef if not, if the IMAP server has the UIDPLUS capability. If it doesn't then you just
get true on success and undef on failure.
Note that many servers will get really ticked off if you try to append a message that contains
"bare newlines", which is the titillating term given to newlines that are not preceded by a
carrage return. To protect against this, B<append> will insert a carrage return before any newline
that is "bare". If you don't like this behavior then you can avoid it by not passing naked newlines
to B<append>.
Note that B<append> does not allow you to specify the internal date or initial flags of an appended
message. If you need this capability then use B<append_string>, below.
=cut
=item append_file()
The B<append_file> method adds a message to the specified folder. It takes two arguments, the
name of the folder to append the message to, and the file name of an RFC822-formatted message.
An optional third argument is the value to use for C<input_record_separator>. The default is
to use "" for the first read (to get the headers) and "\n" for the rest. Any valid value for
C<$/> is acceptable, even the funky stuff, like C<\1024>. (See L<perlvar> for more information
on C<$/>).
The B<append_file> method returns the UID of the new message (a true value) if successful,
or undef if not, if the IMAP server has the UIDPLUS capability. If it doesn't then you just
get true on success and undef on failure. If you supply a filename that doesn't exist then you
get an automatic undef. The B<LastError> method will remind you of this if you forget that your
file doesn't exist but somehow manage to remember to check B<LastError>.
In case you're wondering, B<append_file> is provided mostly as a way to allow large messages
to be appended without having to have the whole file in memory. It uses the C<-s> operator to
obtain the size of the file and then reads and sends the contents line by line (or not, depending
on whether you supplied that optional third argument).
=cut
=item append_string()
The B<append_string> method adds a message to the specified folder. It requires two arguments, the
name of the folder to append the message to, and the text of the message (including headers).
The message text must be included in a single string (unlike B<append>, above).
You can optionally specify a third and fourth argument to B<append_string>. The third argument, if
supplied, is the list of flags to set for the appended message. The list must be specified as a
space-separated list of flags, including any backslashes that may be necessary. The enclosing
parentheses that are required by RFC2060 are optional for B<append_string>. The fourth argument,
if specified, is the date to set as the internal date. It should be in the format described for
I<date_time> fields in RFC2060, i.e. "dd-Mon-yyyy hh:mm:ss +0000".
If you want to specify a date/time but you don't want any flags then specify I<undef> as
the third argument.
The B<append_string> method returns the UID of the new message (a true value) if successful,
or undef if not, if the IMAP server has the UIDPLUS capability. If it doesn't then you just
get true on success and undef on failure.
Note that many servers will get really ticked off if you try to append a message that contains
"bare newlines", which is the titillating term given to newlines that are not preceded by a
carrage return. To protect against this, B<append_string> will insert a carrage return before any newline
that is "bare". If you don't like this behavior then you can avoid it by not passing naked newlines
to B<append_string>.
=cut
=item authenticate()
The B<authenticate> method accepts two arguments, an authentication type to be used (ie CRAM-MD5)
and a code or subroutine reference to execute to obtain a response. The B<authenticate> assumes that
the authentication type specified in the first argument follows a challenge-response flow. The
B<authenticate> method issues the IMAP Client AUTHENTICATE command and receives a challenge from the
server. That challenge (minus any tag prefix or enclosing '+' characters but still in the original
base64 encoding) is passed as the only argument to the code or subroutine referenced in the second
argument. The return value from the 2nd argument's code is written to the server as is, except that
a <CR><NL> sequence is appended if neccessary.
=cut
=item before()
The B<before> method works just like the L<"since"> method, below,
except it returns a list of messages whose internal system dates
are before the date supplied as the argument to the B<before> method.
=cut
=item body_string()
The B<body_string> method accepts a message sequence number (or a message UID, if the I<Uid> parameter
is set to true) as an argument and returns the message body as a string. The returned value contains
the entire message in one scalar variable, without the message headers.
=cut
=item capability()
The B<capability> method returns an array of capabilities as returned by the CAPABILITY IMAP
Client command, or a reference to an array of capabilities if called in scalar context.
If the CAPABILITY IMAP Client command fails for any reason then the B<capability> method will
return undef.
=item close()
The B<close> method is implemented via the default method and is used to close the currently selected folder
via the CLOSE IMAP client command. According to RFC2060, the CLOSE command performs an implicit EXPUNGE,
which means that any messages that you've flagged as I<\Deleted> (say, with the B<delete_message> method) will
now be deleted. If you haven't deleted any messages then B<close> can be thought of as an "unselect".
See also B<delete_message>, B<expunge>, and your tattered copy of RFC2060.
=item connect()
The B<connect> method connects an imap object to the server. It returns C<undef> if it
fails to connect for any reason. If values are available for the I<User> and I<Password>
parameters at the time that B<connect> is invoked, then B<connect> will call the B<login>
method after connecting and return the result of the B<login> method to B<connect>'s caller.
If either or both of the I<User> and I<Password> parameters are unavailable but the connection
to the server succeeds then B<connect> returns a pointer to the B<IMAPClient> object.
The I<Server> parameter must be set (either during B<new> method invocation or
via the B<Server> object method) before invoking B<connect>. If the I<Server> parameter is
supplied to the B<new> method then B<connect> is implicitly called during object construction.
The B<connect> method sets the state of the object to I<connected> if it successfully connects
to the server.
=item copy()
The B<copy> method requires a folder name as the first argument, and a list of one or more messages
sequence numbers (or messages UID's, if the I<UID> parameter is set to a true value). The message
sequence numbers or UID's should refer to messages in the currenly selected folder. Those messages
will be copied into the folder named in the first argument.
The B<copy> method returns undef on failure and a true value if successful. If the server to which
the current Mail::IMAPClient object is connected supports the UIDPLUS capability then the true value
returned by B<copy> will be a comma separated list of UID's, which are the UID's of the newly copied
messages in the target folder.
=cut
=item create()
The B<create> method accepts one argument, the name of a folder (or what RFC2060 calls a "mailbox") to create.
If you specifiy additional arguments to the B<create> method and your server allows additional arguments
to the CREATE IMAP client command then the extra argument(s) will be passed to your server.
If you specifiy additional arguments to the B<create> method and your server does not allow additional arguments
to the CREATE IMAP client command then the extra argument(s) will still be passed to your server and the
create will fail, so don't do that.
B<create> returns a true value on success and undef on failure, as you've probably guessed.
=item delete()
The B<delete> method accepts a single argument, the name of a folder to delete. It returns a true value on
success and undef on failure.
=item delete_message()
The B<delete_message> method accepts a list of arguments. If the I<Uid> parameter is not set to
a true value, then each item in the list should be either:
=over 8
=item >
a message sequence number,
=item >
a comma-separated list of message sequence numbers,
=item >
a reference to an array of message sequence numbers, or
=back
If the I<Uid> parameter is set to a true value, then each item in the list should be either:
=over 8
=item >
a message UID,
=item >
a comma-separated list of UID's, or
=item >
a reference to an array of message UID's.
=back
The messages identified by the sequence numbers or UID's will be deleted. B<delete_message> returns
the number of messages it was told to delete. However, since the delete is done by issuing the
I<+FLAGS.SILENT> option of the STORE IMAP client command, there is no guarantee that the
delete was successful for every message. In this manner the B<delete_message> method sacrifices
accuracy for speed.
If you must have guaranteed results then use the IMAP STORE client command (via the default
method) and use the +FLAGS (\Deleted) option, and then parse your results manually. Eg:
$imap->store($msg_id,'+FLAGS (\Deleted)');
my @results = $imap->History($imap->Transaction);
... # code to parse output goes here
The B<IMAPClient> object must be in I<Selected> status to use the B<delete_message> method.
B<NOTE:> All the messages identified in the input argument(s) must be in the currently
selected folder. Failure to comply to this requirement will almost certainly result in the
wrong message(s) being deleted. This would be a crying shame.
B<NOTE SOME MORE:> In the grand tradition of the IMAP protocol, deleting a message doesn't actually
delete the message. Really. If you want to make sure the message has been deleted, you need to expunge
the folder (via the B<expunge> method, which is implemented via the default method). Or at least B<close> it.
This is generally considered a feature, since after deleting a message, you can change your mind and undelete
it at any time before your B<expunge> or B<close>.
I<See also:> The B<delete> method, to delete a folder, the B<expunge> method, to expunge a folder, the
B<restore_message> method to undelete a message, and the B<close> method (implemented here via the
default method) to close a folder. Oh, and don't forget about RFC2060.
=cut
=item deny_seeing()
The B<deny_seeing> method accepts a list of one or more message sequence numbers, or a single
reference to an array of one or more message sequence numbers, as its argument(s). It then unsets
the "\Seen" flag for those messages. Of course, if the I<Uid> parameter is set to a true value then
those message sequence numbers had better be unique message id's.
didn't you?
Note that specifying C<$imap->deny_seeing(@msgs)> is just a shortcut for specifying
C<$imap->unset_flag("Seen",@msgs)>.
=cut
=item disconnect()
Disconnects the B<IMAPClient> object from the server. Functionally equivalent to the B<logout>
method.
=cut
=item examine()
The B<examine> method selects a folder in read-only mode and changes the object's state to
"Selected". The folder selected via the B<examine> method can be examined but no changes can
be made unless it is first selected via the B<select> method.
The B<examine> method accepts one argument, which is the name of the folder to select.
=cut
=item exists()
Accepts one argument, a folder name. Returns true if the folder exists or false if it does
not exist.
=cut
=item expunge()
The B<expunge> method accepts one optional argument, a folder name. It expunges the folder specified as
the argument, or the currently selected folder if no argument is supplied.
Although RFC2060 does not permit optional arguments (like a folder name) to the EXPUNGE client command,
the B<expunge> method does, which is especially interesting given that the B<expunge> method doesn't
technically exist. In case you're curious, expunging a folder deletes the messages that you thought
were already deleted via B<delete_message> but really weren't, which means you have to use a method that
doesn't exist to delete messages that you thought didn't exist. (Seriously, I'm not making any of
this stuff up.)
Or you could use the B<close> method, which de-selects as well as expunges and which likewise
doesn't technically exist. As with any IMAP client command, that fact that these methods don't
exist will not stop them from working anyway. This is a feature of the B<Mail::IMAPClient> module.
(See L<"Other IMAP Client Commands and the Default Method"> if you still don't believe me.)
=cut
=item fetch()
The B<fetch> method implements the FETCH IMAP client command. It accepts a list of
arguments, which will be converted into a space-delimited list of arguments to the
FETCH IMAP client command. If no arguments are supplied then B<fetch> does a FETCH ALL.
If the I<Uid> parameter is set to a true value then the first argument will be treated as
a UID or list of UID's, which means that the UID FETCH IMAP client command will be run instead
of FETCH. (It would really be a good idea at this point to review RFC2060.)
If called in array context, B<fetch> will return an array of output lines. The output lines
will be returned just as they were received from the server, so your script will have to be
prepared to parse out the bits you want. The only exception to this is literal strings, which
will be inserted into the output line at the point at which they were encountered (without the
{nnn} literal field indicator). See RFC2060 for a description of literal fields, and don't blame
me if you're still confused by them. (I read that rfc just about every day and didn't really
understand those literal fields for about a year.)
If B<fetch> is called in a scalar context, then a reference to an array (as described above)
is returned instead of the entire array.
=cut
=item flags()
The B<flags> method implements the FETCH IMAP client command to list a single message's flags.
It accepts one argument, a message sequence number (or a message UID, if the I<Uid> parameter is
true), and returns an array (or a reference to an array, if called in scalar context) listing the
flags that have been set. Flag names are provided with leading backslashes.
As of version 1.11, you can supply either a list of message id's or a reference to an array of
of message id's (which means either sequence number, if the Uid parameter is false, or message
UID's, if the Uid parameter is true) instead of supplying a single message sequence number or UID.
If you do, then the return value will not be an array or array reference; instead, it will be a
hash reference, with each key being a message sequence number (or UID) and each value being a
reference to an array of flags set for that message.
For example, if you want to display the flags for every message in the folder where you store
e-mail related to your plans for world domination, you could do something like this:
use Mail::IMAPClient;
my $imap = Mail::IMAPClient->new( Server => $imaphost,
User => $login,
Password=> $pass,
Uid => 1, # optional
);
$imap->select("World Domination");
# get the flags for every message in my 'World Domination' folder
$flaghash = $imap->flags( scalar($imap->search("ALL"))) ;
# pump through sorted hash keys to print results:
for my $k (sort { $flaghash->{$a} <=> $flaghash->{$b} } keys %$flaghash) {
# print: Message 1: \Flag1, \Flag2, \Flag3
print "Message $k:\t",join(", ",@{$flaghash->{$k}}),"\n";
}
=cut
=item folders()
The B<folders> method returns an array listing the available folders. It will only be
successful if the object is in the B<Authenticated> or B<Selected> states.
=cut
=item has_capability()
Returns true if the IMAP server to which the B<IMAPClient> object is connected has the capability
specified as an argument to B<has_capability>.
=item imap4rev1()
Returns true if the IMAP server to which the B<IMAPClient> object is connected has the IMAP4REV1 capability.
=item internaldate()
B<internaldate> accepts one argument, a message id (or UID if the Uid parameter is true), and returns
that message's internal date.
=item get_bodystructure
The B<get_bodystructure> method accepts one argument, a message sequence number or, if I<Uid> is true,
a message UID. It obtains the message's body structure and returns a B<Mail::IMAPClient::BodyStructure>
object for the message.
=item getacl()
B<getacl> accepts one argument, the name of a folder. If no argument is provided then the currently selected folder
is used as the default. It returns a reference to a hash. The keys of the hash are userids that have access to the
folder, and the value of each element are the permissions for that user. The permissions are listed in a string in
the order returned from the server with no whitespace or punctuation between them.
=cut
=item is_parent()
The B<is_parent> method accepts one argument, the name of a folder. It returns a value
that indicates whether or not the folder has children. The value it returns is either
1) a true value (indicating that the folder has children), 2) 0 if the folder has no
children at this time, or 3) undef if the folder is not permitted to have children.
Eg:
my $parenthood = $imap->is_parent($folder);
if (defined($parenthood)) {
if ($parenthood) {
print "$folder has children.\n" ;
} else {
print "$folder is permitted children, but has none.\n";
}
} else {
print "$folder is not permitted to have children.\n";
}
=cut
=item list()
The B<list> method implements the IMAP LIST client command. Arguments are passed to the
IMAP server as received, separated from each other by spaces. If no arguments are supplied
then the default list command C<tag LIST "" '*'> is issued.
The B<list> method returns an array (or an array reference, if called in a scalar context).
The array is the unaltered output of the LIST command. (If you want your output altered then
see the B<folders> method, above.)
=cut
=item listrights
The B<listrights> method implements the IMAP LISTRIGHTS client command (L<RFC2086>).
=item login()
The B<login> method uses the IMAP LOGIN client command (as defined in RFC2060) to log into
the server. The I<User> and I<Password> parameters must be set before the B<login> method
can be invoked. If successful, the B<login> method returns a pointer to the B<IMAPClient> object
and sets the object status to I<Authenticated>. If unsuccessful, it returns undef.
=cut
=item logout()
The B<logout> method issues the LOGOUT IMAP client commmand. Since the LOGOUT IMAP client
command causes the server to end the connection, this also results in the B<IMAPClient> client
entering the B<Unconnected> state. This method does not, however, destroy the B<IMAPClient> object,
so a program can re-invoke the B<connect> and B<login> methods if it wishes to reestablish
a session later in the program.
=cut
=item lsub()
The B<lsub> method implements the IMAP LSUB client command. Arguments are passed to the
IMAP server as received, separated from each other by spaces. If no arguments are supplied
then the default lsub command C<tag LSUB "" '*'> is issued.
The B<lsub> method returns an array (or an array reference, if called in a scalar context).
The array is the unaltered output of the LSUB command. If you want an array of subscribed folders
then see the B<subscribed> method, below.
=cut
=item mark()
The B<mark> method accepts a list of one or more messages sequence numbers, or a single reference to an
array of one or more message sequence numbers, as its argument(s). It then sets the "\Flagged" flag for
those message(s). Of course, if the I<Uid> parameter is set to a true value then those message
sequence numbers had better be unique message id's.
Note that specifying C<$imap->see(@msgs)> is just a shortcut for specifying
C<$imap->set_flag("Flagged",@msgs)>.
=cut
=item message_count()
The B<message_count> method accepts the name of a folder as an argument and returns the number
of messages in that folder. Internally, it invokes the B<status> method (see above) and
parses out the results to obtain the number of messages. If you don't supply an argument to
B<message_count> then it will return the number of messages in the currently selected folder
(assuming of course that you've used the B<select> or B<examine> method to select it instead of
trying something funky).
=cut
=item message_string()
The B<message_string> method accepts a message sequence number (or message UID if I<Uid> is true)
as an argument and returns the message as a string. The returned value contains the entire message
in one scalar variable, including the message headers. Note that using this method will set the
message's "\Seen" flag as a side effect, unless I<Peek> is set to a true value.
=cut
=item message_to_file()
The B<message_to_file> method accepts a filename or file handle and one or more message sequence numbers
(or message UIDs if I<Uid> is true) as arguments and places the message string(s) (including RFC822 headers)
into the file named in the first argument (or prints them to the filehandle, if a filehandle is passed).
The returned value is true on succes and undef on failure.
If the first argument is a reference, it is assumed to be an open filehandle and will not be
closed when the method completes, If it is a file, it is opened in append mode, written to, then closed.
Note that using this method will set the message's "\Seen" flag as a side effect. But you can use
the B<deny_seeing> method to set it back, or set the I<Peek> parameter to a true value to prevent
setting the "\Seen" flag at all.
This method currently works by making some basic assumptions about the server's behavior, notably
that the message text will be returned as a literal string but that nothing else will be. If you have
a better idea then I'd like to hear it.
=cut
=item message_uid()
The B<message_uid> method accepts a message sequence number (or message UID if I<Uid> is true)
as an argument and returns the message's UID. Yes, if I<Uid> is true then it will use the IMAP
UID FETCH UID client command to obtain and return the very same argument you supplied. This is an
IMAP feature so don't complain to me about it.
=cut
=item migrate()
The B<migrate> method copies the indicated messages from the currently selected folder to another
B<Mail::IMAPClient> object's session. It requires n arguments:
1. a reference to the target object;
2. the message(s) to be copied, specified as either a) the message sequence number (or message
UID if the UID parameter is true) of a single message, b) a reference to an array of message
sequence numbers (or message UID's if the UID parameter is true) or c) the special string "ALL",
which is a shortcut for the results of B<search("ALL")>.
3. the folder name of a folder on the target mailbox to receive the message(s). If this argument is
not supplied or if I<undef> is supplied then a folder with the same name as the currently selected
folder on the calling object will be created if necessary and used. If you specify something other
then I<undef> for this argument, even if it's '$imap1->Folder' or the name of the currently selected
folder then that folder will only be used if it exists on the target object's mailbox; otherwise
B<migrate> will fail.
The B<migrate> method uses Black Magic to hardwire the I/O between the two B<Mail::IMAPClient> objects in order
to minimize resource consumption. If you have older scripts that used B<message_to_file> and B<append_file> to
move large messages between IMAP mailboxes then you may want to try this method as a possible replacement.
=item move()
The B<move> method moves messages from the currently selected folder to the folder specified
in the first argument to B<move>. If the I<Uid> parameter is not true, then the rest of the arguments
should be either:
=over 8
=item >
a message sequence number,
=item >
a comma-separated list of message sequence numbers, or
=item >
a reference to an array of message sequence numbers.
=back
If the I<Uid> parameter is true, then the arguments should be:
=over 8
=item >
a message UID,
=item >
a comma-separated list of message UID's, or
=item >
a reference to an array of message UID's.
=back
If the target folder does not exist then it will be created.
If move is sucessful, then it returns a true value. Furthermore, if the B<Mail::IMAPClient>
object is connected to a server that has the UIDPLUS capability, then the true value will
be the comma-separated list of UID's for the newly copied messages. The list will be in the
order in which the messages were moved. (Since B<move> uses the copy method, the messages will
be moved in numerical order.)
If the move is not successful then B<move> returns undef.
Note that a move really just involves copying the message to the new folder and then setting the I<\Deleted>
flag. To actually delete the original message you will need to run B<expunge> (or B<close>).
=cut
=item namespace()
The namespace method runs the NAMESPACE IMAP command (as defined in RFC 2342). When called in a
list context, it returns a list of three references. Each reference looks like this:
[ [ $prefix_1, $separator_1 ] , [ $prefix_2, $separator_2], [ $prefix_n , $separator_n] ]
The first reference provides a list of prefices and separator charactors for the available
personal namespaces. The second reference provides a list of prefices and separator charactors
for the available shared namespaces. The third reference provides a list of prefices and separator
charactors for the available public namespaces.
If any of the three namespaces are unavailable on the current server then an 'undef' is returned
instead of a reference. So for example if shared folders were not supported on the server but
personal and public namespaces were both available (with one namespace each), the returned value
might resemble this:
( [ "", "/" ] , undef, [ "#news", "." ] ) ;
If the B<namespace> method is called in scalar context, it returns a reference to the
above-mentioned list of three references, thus creating a single structure that would
pretty-print something like this:
$VAR1 = [
[
[ $user_prefix_1, $user_separator_1 ] ,
[ $user_prefix_2, $user_separator_2],
[ $user_prefix_n , $user_separator_n]
] , # or undef
[
[ $shared_prefix_1, $shared_separator_1 ] ,
[ $shared_prefix_2, $shared_separator_2],
[ $shared_prefix_n , $shared_separator_n]
] , # or undef
[
[ $public_prefix_1, $public_separator_1 ] ,
[ $public_prefix_2, $public_separator_2],
[ $public_prefix_n , $public_separator_n]
] , # or undef
];
Or, to look at our previous example (where shared folders are unsupported) called in scalar context:
$VAR1 = [
[
[
"" ,
"/",
],
],
undef,
[
[
"#news",
"."
],
],
];
=cut
=item on()
The B<on> method works just like the B<since> method, below, except it returns a list of messages
whose internal system dates are the same as the date supplied as the argument.
=item parse_headers ()
The B<parse_headers> method accepts as arguments a message sequence number and a list of header
fields. It returns a hash reference in which the keys are the header field names (without the colon)
and the values are references to arrays of values. A picture would look something like this:
$hashref = $imap->parse_headers(1,"Date","Received","Subject","To");
$hashref = {
"Date" => [ "Thu, 09 Sep 1999 09:49:04 -0400" ] ,
"Received" => [ q/
from mailhub ([111.11.111.111]) by mailhost.bigco.com
(Netscape Messaging Server 3.6) with ESMTP id AAA527D for
<bigshot@bigco.com>; Fri, 18 Jun 1999 16:29:07 +0000
/, q/
from directory-daemon by mailhub.bigco.com (PMDF V5.2-31 #38473)
id <0FDJ0010174HF7@mailhub.bigco.com> for bigshot@bigco.com
(ORCPT rfc822;big.shot@bigco.com); Fri, 18 Jun 1999 16:29:05 +0000 (GMT)
/, q/
from someplace ([999.9.99.99]) by smtp-relay.bigco.com (PMDF V5.2-31 #38473)
with ESMTP id <0FDJ0000P74H0W@smtp-relay.bigco.com> for big.shot@bigco.com; Fri,
18 Jun 1999 16:29:05 +0000 (GMT)
/] ,
"Subject" => [ qw/ Help! I've fallen and I can't get up!/ ] ,
"To" => [ "Big Shot <big.shot@bigco.com> ] ,
} ;
The text in the example for the "Received" array has been formated to make reading the
example easier. The actual values returned are just strings of words separated by spaces and
with newlines and carriage returns stripped off. The I<Received> header is probably the main reason
that the B<parse_headers> method creates a hash of lists rather than a hash of values.
If the second argument to B<parse_headers> is 'ALL' or if it is unspecified then all available headers
are included in the returned hash of lists.
If you're not emotionally prepared to deal with a hash of lists then you can always call the
B<fetch> method yourself with the appropriate parameters and parse the data out any way you want to.
If the I<Uid> parameter is true then the first argument will be treated as a message UID. If the first
argument is a reference to an array of message sequence numbers (or UID's if Uid is true), then
B<parse_headers> will be run against each message in the array. In this case the return value is
a hash, in which the key is the message sequence number (or UID) and the value is a reference to
a hash as described above.
An example of using B<parse_headers> to print the date and subject of every message in your smut
folder could look like this:
use Mail::IMAPClient;
my $imap = Mail::IMAPClient->new( Server => $imaphost,
User => $login,
Password=> $pass,
Uid => 1, # optional
);
$imap->select("smut");
for my $h (
# grab the Subject and Date from every message in my (fictional!) smut folder;
# the first argument is a reference to an array listing all messages in the folder
# (which is what gets returned by the $imap->search("ALL") method when called in
# scalar context) and the remaining arguments are the fields to parse out
# The key is the message number, which in this case we don't care about:
values %{$imap->parse_headers( scalar($imap->search("ALL")) , "Subject", "Date")}
) {
# $h is the value of each element in the hash ref returned from parse_headers,
# and $h is also a reference to a hash.
# We'll only print the first occurance of each field because we don't expect more
# than one Date: or Subject: line per message.
print map { "$_:\t$h->{$_}[0]\n"} keys %$h ;
}
=cut
=item recent()
The B<recent> method performs an IMAP SEARCH RECENT search against the selected folder and returns
an array of sequence numbers (or UID's, if the I<Uid> parameter is true) of messages that are recent.
=cut
=item recent_count()
The B<recent_count> method accepts as an argument a folder name. It returns the number of recent
messages in the folder (as returned by the IMAP client command "STATUS folder RECENT"), or undef
in the case of an error. The B<recent_count> method was contributed by Rob Deker (deker@ikimbo.com).
=cut
=item rename()
The B<rename> method accepts two arguments: the name of an existing folder, and a new name for
the folder. The existing folder will be renamed to the new name using the RENAME IMAP client
command. B<rename> will return a true value if successful, or undef if unsuccessful.
=cut
=item restore_message()
The B<restore_message> method is used to undo a previous B<delete_message> operation (but not if there
has been an intervening B<expunge> or B<close>). The B<IMAPClient> object must be in I<Selected> status
to use the B<restore_message> method.
The B<restore_message> method accepts a list of arguments. If the I<Uid> parameter is not set to a
true value, then each item in the list should be either:
=over 8
=item >
a message sequence number,
=item >
a comma-separated list of message sequence numbers,
=item >
a reference to an array of message sequence numbers, or
=back
If the I<Uid> parameter is set to a true value, then each item in the list should be either:
=over 8
=item >
a message UID,
=item >
a comma-separated list of UID's, or
=item >
a reference to an array of message UID's.
=back
The messages identified by the sequence numbers or UID's will have their I<\Deleted> flags cleared,
effectively "undeleting" the messages. B<restore_message> returns the number of messages it was able
to restore.
Note that B<restore_messages> is similar to calling B<unset_flag("\Deleted",@msgs)>, except that
B<restore_messages> returns a more meaningful value.
=cut
=item run()
Like Perl itself, the B<Mail::IMAPClient> module is designed to make common things easy and
uncommon things possible. The B<run> method is provided to make those uncommon things possible.
The B<run> method excepts one or two arguments. The first argument is a string containing
an IMAP Client command, including a tag and all required arguments. The optional second
argument is a string to look for that will indicate success. (The default is C</OK.*/>).
The B<run> method returns an array of output lines from the command, which you are free to parse
as you see fit.
The B<run> method does not do any syntax checking, other than rudimentary checking for a tag.
When B<run> processes the command, it increments the transaction count and saves the command and
responses in the History buffer in the same way other commands do. However, it also creates a
special entry in the History buffer named after the tag supplied in the string passed as the
first argument. If you supply a numeric value as the tag then you may risk overwriting a previous
transaction's entry in the History buffer.
If you want the control of B<run> but you don't want to worry about the damn tags then see
L<"tag_and_run">, below.
=cut
=item search()
The B<search> method implements the SEARCH IMAP client command. Any argument supplied to
B<search> is prefixed with a space and appended to the SEARCH IMAP client command. This
method is another one of those situations where it will really help to have your copy of
RFC2060 handy, since the SEARCH IMAP client command contains a plethora of options and
possible arguments. I'm not going to repeat them here.
Remember that if your argument needs quotes around it then you must make sure that the
quotes will be preserved when passing the argument. I.e. use C<qq/"$arg"/> instead of
C<"$arg">.
The B<search> method returns an array containing sequence numbers of messages that passed the
SEARCH IMAP client command's search criteria. If the I<Uid> parameter is true then the array
will contain message UID's. If B<search> is called in scalar context then a pointer to the array
will be passed, instead of the array itself.
=cut
=item sort()
The B<sort> method is just like the B<search> method, only different.
It implements the SORT extension as described in
http://search.ietf.org/internet-drafts/draft-ietf-imapext-sort-06.txt.
It would be wise to use the B<has_capability> method to verify that the SORT
capability is available on your server before trying to use the B<sort> method. If you forget
to check and you're connecting to a server that doesn't have the SORT capability then
B<sort> will return undef. B<LastError> will then say you are "BAD". If your server doesn't
support the SORT capability then you'll have to use B<search> and then sort the results yourself.
The first argument to B<sort> is a space-delimited list of sorting criteria. The Internet Draft
that describes SORT requires that this list be wrapped in parentheses, even if there is only one
sort criterion. If you forget the parentheses then the B<sort> method will add them. But you have
to forget both of them, or none. I'm not CMS running under VM!
The second argument is a character set to use for sorting. Different character
sets use different sorting orders, so this argument is important. Since all servers
must support UTF-8 and US-ASCII if they support the SORT capability at all, use one
of those if you don't have some other preferred character set in mind.
The rest of the arguments are searching criteria, just as you would supply to the B<search> method.
These are all documented in RFC2060. If you just want all of the messages in the currently selected
folder returned to you in sorted order, use I<ALL> as your only search criterion.
The B<sort> method returns an array containing sequence numbers of messages that passed the
SORT IMAP client command's search criteria. If the I<Uid> parameter is true then the array
will contain message UID's. If B<sort> is called in scalar context then a pointer to the array
will be passed, instead of the array itself. The message sequence numbers or unique identifiers
are ordered according to the sort criteria specified. The sort criteria are nested in the order
specified; that is, items are sorted first by the first criterion, and within the first criterion
they are sorted by the second criterion, and so on.
=item see()
The B<see> method accepts a list of one or more messages sequence numbers, or a single reference to an
array of one or more message sequence numbers, as its argument(s). It then sets the "\Seen" flag for
those message(s). Of course, if the I<Uid> parameter is set to a true value then those message
sequence numbers had better be unique message id's, but then you already knew that, didn't you?
Note that specifying C<$imap->see(@msgs)> is just a shortcut for specifying
C<$imap->set_flag("Seen",@msgs)>.
=cut
=item seen()
The B<seen> method performs an IMAP SEARCH SEEN search against the selected folder and returns
an array of sequence numbers of messages that have already been seen (ie their SEEN flag is set).
If the I<Uid> parameter is true then an array of message UID's will be returned instead. If called
in scalar context than a pointer to the array (rather than the array itself) will be returned.
=cut
=item select()
The B<select> method selects a folder and changes the object's state to "Selected".
It accepts one argument, which is the name of the folder to select.
=cut
=item sentbefore()
The B<sentbefore> works just like L<"sentsince">, below, except it searches for messages that were
sent before the date supplied as an argument to the method.
=cut
=item senton()
The B<senton> works just like L<"sentsince">, below, except it searches for messages that were
sent on the exact date supplied as an argument to the method.
=cut
=item sentsince()
The B<sentsince> method accepts one argument, a date in either standard perl format (seconds since
1/1/1970, or as output by L<time|perlfunc/time> and as accepted by L<localtime|perlfunc/localtime>)
or in the I<date_text> format as defined in RFC2060 (dd-Mon-yyyy, where Mon is the English-language
three-letter abbreviation for the month).
It searches for items in the currently selected folder for messages sent since the day whose date
is provided as the argument. It uses the RFC822 I<Date:> header to determine the I<sentsince> date.
In the case of arguments supplied as a number of seconds, the returned result list will include
items sent on or after that day, regardless of whether they arrived before the specified time on
that day. The IMAP protocol does not support searches at a granularity finer than a day, so
neither do I. On the other hand, the only thing I check for in a I<date_text> argument is that it
matches the pattern C</\d\d-\D\D\D-\d\d\d\d/> (notice the lack of anchors), so if your server lets you
add something extra to a I<date_text> string then so will B<Mail::IMAPClient>.
=cut
=item separator()
The B<separator> method returns the character used as a separator character in
folder hierarchies. On unix-based servers, this is often a forward slash (/). It accepts one
argument, the name of a folder whose hierarchy's separator should be returned. If no folder
name is supplied then the separator for the INBOX is returned, which probably is good enough.
=cut
=item set_flag()
The B<set_flag> method accepts the name of a flag as its first argument and a list of one or more messages
sequence numbers, or a single reference to an array of one or more message sequence numbers, as its
next argument(s). It then sets the flag specified for those message(s). Of course, if the I<Uid>
parameter is set to a true value then those message sequence numbers had better be unique message id's,
just as you'd expect.
Note that when specifying the flag in question, the preceding backslash (\) is entirely optional. (For you,
that is. B<Mail::IMAPClient> still has remember to stick it in there before passing the command to the
server. This is in fact so important that the method checks its argument and adds the backslash when necessary,
which is why you don't have to worry about it overly much.)
=cut
=item setacl()
The B<setacl> method accepts three input arguments, a folder name, a user id (or authentication
identifier, to use the terminology of RFC2086), and an access rights modification string. See
RFC2086 for more information. (This is somewhat experimental and its implementation may change.)
=cut
=item since()
The B<since> method accepts a date in either standard perl format (seconds since 1/1/1970, or
as output by L<perlfunc/time> and as accepted by L<perlfunc/localtime>) or in the I<date_text>
format as defined in RFC2060 (dd-Mon-yyyy, where Mon is the English-language three-letter
abbreviation for the month).
It searches for items in the currently selected folder for messages whose internal dates are on or
after the day whose date is provided as the argument. It uses the internal system date for a
message to determine if that message was sent since the given date.
In the case of arguments supplied as a number of seconds, the returned result list will include
items whose internal date is on or after that day, regardless of whether they arrived before the
specified time on that day.
=cut
=item size()
The B<size> method accepts one input argument, a sequence number (or message UID if the I<Uid> parameter
is true). It returns the size of the message in the currently selected folder with the supplied
sequence number (or UID). The B<IMAPClient> object must be in a I<Selected> state in order to use
this method.
=cut
=item status()
The B<status> method accepts one argument, the name of a folder (or mailbox, to use
RFC2060's terminology), and returns an array containing the results of running the IMAP
STATUS client command against that folder. If additional arguments are supplied then they
are appended to the IMAP STATUS client command string, separated from the rest of the string
and each other with spaces.
If B<status> is not called in an array context then it returns a reference to an array
rather than the array itself.
The B<status> method should not be confused with the B<Status> method (with an uppercase 'S'),
which returns information about the B<IMAPClient> object. (See the section labeled
L<"Status Methods">, below).
=cut
=item store()
The B<store> method accepts a message sequence number or comma-separated list of message sequence numbers
as a first argument, a message data item name, and a value for the message data item. Currently, data items
are the word "FLAGS" followed by a space and a list of flags (in parens). The word "FLAGS" can be modified
by prefixing it with either a "+" or a "-" (to indicate "add these flags" or "remove these flags") and by
suffixing it with ".SILENT" (which reduces the amount of output from the server; very useful with large message
sets). Normally you won't need to call B<store> because there are oodles of methods that will invoke store for
you with the correct arguments. Furthermore, these methods are friendlier and more flexible with regards to
how you specify your arguments. See for example L<see>, L<deny_seeing>, L<delete_message>, and
L<restore_message>. Or L<mark>, L<unmark>, L<set_flag>, and L<unset_flag>.
=item subscribed()
The B<subscribed> method works like the B<folders> method, above, except that the returned list (or
array reference, if called in scalar context) contains only the subscribed folders.
=item tag_and_run()
The B<tag_and_run> method accepts one or two arguments. The first argument is a string containing
an IMAP Client command, without a tag but with all required arguments. The optional second
argument is a string to look for that will indicate success (without pattern delimiters).
The default is C<OK.*>.
The B<tag_and_run> method will prefix your string (from the first argument) with the next
transaction number and run the command. It returns an array of output lines from the command,
which you are free to parse as you see fit. Using this method instead of B<run> (above) will
free you from having to worry about handling the tags (and from worrying about the side affects of
naming your own tags).
=cut
=item uidnext()
The B<uidnext> method accepts one argument, the name of a folder, and returns the numeric string
that is the next available message UID for that folder.
=item uidvalidity()
The B<uidvalidity> method accepts one argument, the name of a folder, and returns the numeric string
that is the unique identifier validity value for the folder.
=item unmark()
The B<unmark> method accepts a list of one or more messages sequence numbers, or a single reference to an
array of one or more message sequence numbers, as its argument(s). It then unsets the "\Flagged" flag for
those message(s). Of course, if the I<Uid> parameter is set to a true value then those message
sequence numbers should really be unique message id's.
Note that specifying C<$imap->see(@msgs)> is just a shortcut for specifying
C<$imap->unset_flag("Flagged",@msgs)>.
=cut
=item unseen()
The B<unseen> method performs an IMAP SEARCH UNSEEN search against the selected folder and returns
an array of sequence numbers of messages that have not yet been seen (ie their SEEN flag is not set).
If the I<Uid> parameter is true then an array of message UID's will be returned instead. If called
in scalar context than a pointer to the array (rather than the array itself) will be returned.
Note that when specifying the flag in question, the preceding backslash (\) is entirely optional.
=cut
=item unseen_count()
The B<unseen_count> method accepts the name of a folder as an argument and returns the number of unseen
messages in that folder. If no folder argument is provided then it returns the number of unseen messages
in the currently selected Folder.
=item unset_flag()
The B<unset_flag> method accepts the name of a flag as its first argument and a list of one or more
messages sequence numbers, or a single reference to an array of one or more message sequence numbers,
as its next argument(s). It then unsets the flag specified for those message(s). Of course, if the I<Uid>
parameter is set to a true value then those message sequence numbers had better be unique message id's,
just as you'd expect.
=cut
=item Other IMAP Client Commands and the Default Method()
IMAP Client Commands not otherwise documented have been implemented via an AUTOLOAD hack and use
a default method.
If a program calls a method that is not defined (or inherited) by the B<IMAPClient> module then
the B<IMAPClient> module will assume that it is an IMAP client command. It will prefix the command
with the next available transaction number (or tag value), and append to it the
space-delimited list of arguments supplied to the unimplemented method (if any). It will then read lines
of output from the imap session until it finds a line containing the strings "OK" and
"Completed", and return an array containing all of the lines of output (or, if called in scalar
context, an array reference). If it finds "BAD" or "NO" instead of "OK" it returns undef.
Eg:
$imap->FOO("bar","an example","of the default");
results in:
"99 FOO bar an example of the default\r\n"
being sent to the IMAP server (assuming that 99 is the current transaction number).
Notice that we used an uppercase method name "FOO" so as not to conflict with future implementations of that
IMAP command. If you run your script with warnings turned on (always a good idea, at least during testing),
then you will receive warnings whenever you use a lowercase method name that has not been implemented. An
exception to this is when you use certain common (yet unimplemented) methods that, if ever explicitly implemented,
are guaranteed to behave just like the default method. To date, those methods are either documented in the section
labeled L<Object Methods>, above, or listed here:
=over 8
=item copy($msg,$folder)
Copy a message into a folder.
=item subscribe($folder)
Subscribe to a folder
=back
B<CAUTION:> Once again, remember to quote your quotes if you want quotes to be part of the
IMAP command string.
You can also use the default method to override the behavior of implemented IMAP methods by
changing the case of the method name, preferably to all-uppercase so as not to conflict with
the Class method and accessor method namespace. For example, if you don't want the B<search>
method's behavior (which returns a list of message numbers) but would rather have an array
of raw data returned from your B<search> operation, you can issue the following snippet:
my @raw = $imap->SEARCH("SUBJECT","Whatever...");
which is slightly more efficient than the equivalent:
$imap->search("SUBJECT","Whatever...");
my @raw = $imap->Results;
=cut
=item Status Methods
There are several object methods that return the status of the object. They can be
used at any time to check the status of an B<IMAPClient> object, but are particularly useful
for determining the cause of failure when a connection and login are attempted as part of
a single B<new> method invocation. The status methods are:
=over 8
=item 0. Escaped_results
The B<Escaped_results> method is almost identical to the B<History> method. Unlike the B<History>
method, however, server output transmitted literally will be wrapped in double quotes, with all of
the parentheses, double quotes, backslashes, newlines, and carrage returns escaped. If called in
a scalar context, B<Escaped_results> returns an array reference rather than an array.
B<Escaped_results> is useful if you are retrieving output and processing it manually, and you are
depending on the above special characters to delimit the data. It is not useful when
retrieving message contents; use B<message_string> or B<body_string> for that.
=item 1. History
The B<History> method is almost identical to the B<Results> method. Unlike the B<Results>
method, however, the IMAP command that was issued to create the results being returned is
not included in the returned results. If called in a scalar context, B<History> returns an
array reference rather than an array.
=item 2. IsUnconnected
returns a true value if the object is currently in an B<Unconnected> state.
=item 3. IsConnected
returns a true value if the object is currently in either a B<Connected, Authenticated>, or
B<Selected> state.
=item 4. IsAuthenticated
returns a true value if the object is currently in either an B<Authenticated> or
B<Selected> state.
=item 5. IsSelected
returns a true value if the object is currently in a B<Selected> state.
=item 6. LastError
Internally B<LastError> is implemented just like a parameter (as described in L<"Parameters">, above).
There is a I<LastError> attribute and an eponymous accessor method which returns the I<LastError> text
string describing the last error condition encountered by the server.
Note that some errors are more serious than others, so I<LastError>'s value is only meaningful
if you encounter an error condition that you don't like. For example, if you use the B<exists>
method to see if a folder exists and the folder does not exist, then an error message will be
recorded in LastError even though this is not a particularly serious error. On the other hand,
if you didn't use B<exists> and just tried to B<select> a non-existing folder, then B<select>
would return undef after setting I<LastError> to something like "NO SELECT failed: Can't open
mailbox <mailbox>: no such mailbox". At this point it would be useful to print out the contents
of I<LastError> as you B<die>.
=item 7. LastIMAPCommand
New in version 2.0.4, B<LastIMAPCommand> returns the exact IMAP command string to be sent to the
server. Useful mainly in constructing error messages when B<LastError> just isn't enough.
=item 8. Report
The B<Report> method returns an array containing a history of the IMAP session up to the
point that B<Report> was called. It is primarily meant to assist in debugging but can also
be used to retrieve raw output for manual parsing. The value of the B<Clear> parameter controls
how many transactions are in the report. (See the discussion of B<Clear> in
L<"parameters">, above.)
=cut
=item 9. Results
The B<Results> method returns an array containing the results of one IMAP client command.
It accepts one argument, the transaction number of the command whose results are to be
returned. If transaction number is unspecified then B<Results> returns the results of the
last IMAP client command issued. If called in a scalar context, B<Results> returns an
array reference rather than an array.
=cut
=item 10. State
The B<State> method returns a numerical value that indicates the current status of the B<IMAPClient>
object. If invoked with an argument, it will set the object's state to that value. If invoked without
an argument, it behaves just like B<Status>, below.
Normally you will not have to invoke this function. An exception is if you are bypassing the
B<Mail::IMAPClient> module's B<connect> and/or B<login> modules to set up your own connection
(say, for example, over a secure socket), in which case you must manually do what the B<connect>
and B<login> methods would otherwise do for you.
=item 11. Status
The B<Status> method returns a numerical value that indicates the current status of the B<IMAPClient>
object. (Not to be confused with the B<status> method, all lower-case, which is the implementation of the
STATUS IMAP client command.)
=item 12. Transaction
The B<Transaction> method returns the tag value (or transaction number) of the last IMAP client command.
=back
=back
=cut
=head1 REPORTING BUGS
Please feel free to e-mail the author at the below address if you encounter any strange behaviors.
When reporting a bug, please be sure to include the following:
- As much information about your environment as possible. I especially need to know which version
of Mail::IMAPClient you are running and the type/version of IMAP server to which you are connecting.
- As detailed a description of the problem as possible. (What are you doing? What happens?)
- An example script that demonstrates the problem (preferably with as few lines of code as possible!)
and which calls the Mail::IMAPClient's B<new> method with the I<Debug> parameter set to "1".
- Output from the example script when it's running with the Debug parameter turned on. You can
edit the output to remove (or preferably to "X" out) sensitive data, such as hostnames, user
names, and passwords, but PLEASE do not remove the text that identifies the TYPE of IMAP server
to which you are connecting. Note that in the latest versions of Mail::IMAPClient, debugging does
not print out the user or password from the login command line. However, if you use some other means
of authenticating then you may need to edit the debugging output with an eye to security.
- Don't be surprised if I come back asking for a trace of the problem. To provide this, you should create
a file called I<.perldb> in your current working directory and include the following line of text in
that file:
C<&parse_options("NonStop=1 LineInfo=mail_imapclient_db.out");>
For your debugging convenience, a sample .perldb file, which was randomly assigned the name
F<sample.perldb>, is provided in the distribution.
Next, without changing your working directory, debug the example script like this:
C<perl -d example_script.pl [ args ]>
Note that in these examples, the script that demonstrates your problem is named "example_script.pl"
and the trace output will be saved in "mail_imapclient_db.out". You should change these to suite
your needs.
=head1 AUTHOR
David J. Kernen
The Kernen Consulting Group, Inc
david.kernen@erols.com
=cut
=head1 COPYRIGHT
Copyright 1999, 2000 The Kernen Group, Inc.
All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the terms of either:
=over 4
=item a) the "Artistic License" which comes with this Kit, or
=item b) the GNU General Public License as published by the Free Software Foundation; either
version 1, or (at your option) any later version.
=back
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
the GNU General Public License or the Artistic License for more details.
=cut
my $not_void_context = '0 but true'; # return true value
# $Log: IMAPClient.pm,v $
# Revision 20001010.9 2001/02/07 20:19:50 dkernen
#
# Modified Files: Changes IMAPClient.pm MANIFEST Makefile test.txt -- up to version 2.1.0
#
# Revision 20001010.8 2001/01/09 19:24:29 dkernen
#
# Modified Files:
# Changes IMAPClient.pm Makefile test.txt -- to add Phil Lobbe's patch.
#
# Revision 1.1 2000/12/27 01:22:35 phil
# Initial revision
#
# Revision 20001010.7 2000/12/20 19:36:52 dkernen
#
# ---------------------------------------------------------------------------------
# Modified Files: IMAPClient.pm -- added bug fix to I/O engine, also cleaned up doc
# Changes -- documented same
# ---------------------------------------------------------------------------------
#
# Revision 20001010.6 2000/11/10 22:08:06 dkernen
#
# Modified Files: Changes IMAPClient.pm Makefile t/basic.t -- to add Peek parm and to make several bug fixes
#
# Revision 20001010.5 2000/10/30 21:04:51 dkernen
#
# Modified Files: IMAPClient.pm -- updated version to 2.0.2.
#
# Revision 20001010.4 2000/10/30 21:03:50 dkernen
#
# Modified Files: Changes IMAPClient.pm -- to update documentation
#
# Revision 20001010.3 2000/10/30 18:40:02 dkernen
#
# Modified Files: Changes IMAPClient.pm INSTALL MANIFEST Makefile README test.txt -- for 2.0.1
#
# Revision 20001010.2 2000/10/27 14:43:25 dkernen
#
# Modified Files: Changes IMAPClient.pm Todo -- major rewrite of I/O et al.
#
# Revision 20001010.1 2000/10/10 17:32:15 dkernen
#
# ----------------------------------------------------------------------
# Tag: v1_19 rev 20001010.1
# Modified Files:
# .nstest .uwtest45 .uwtest47 Artistic Changes Copying
# IMAPClient.pm INSTALL MANIFEST Makefile Makefile.PL README
# Todo pm_to_blib test.txt test_template.txt
# See Changes for a list of changes in v1.19
# ----------------------------------------------------------------------
#
# Revision 19991216.17 2000/07/10 20:54:02 dkernen
#
# Modified Files: Changes IMAPClient.pm MANIFEST Makefile README
#
# Revision 19991216.16 2000/06/23 19:07:53 dkernen
#
# Modified Files:
# Changes IMAPClient.pm Makefile test.txt -- for v1.16
#
# Revision 19991216.15 2000/06/21 21:07:37 dkernen
#
# Modified Files: Changes IMAPClient.pm Makefile
#
# Revision 19991216.14 2000/05/22 20:10:25 dkernen
#
# Modified Files: Changes IMAPClient.pm
#
# Revision 19991216.13 2000/04/27 17:59:45 dkernen
#
# Modified Files:
# Changes IMAPClient.pm INSTALL MANIFEST Makefile README
# test.txt
# Added Files:
# .uwtest45 .uwtest47
# Removed Files:
# .uwtest
#
# Revision 19991216.12 2000/03/16 14:55:23 dkernen
#
# Changes - to document changes
# IMAPClient.pm - to add lsub and subscribed methods
# Makefile - to increment version to 1.10
#
# Revision 19991216.11 2000/03/09 20:32:28 dkernen
#
# Modified Files:
# IMAPClient.pm -- to fix bugs in recent, seen, and unseen
# Changes -- to document same
#
# Revision 19991216.10 2000/03/09 14:05:18 dkernen
#
# Modified Files:
# Changes -- to document changes
# IMAPClient.pm -- to add new methods since, sentsince, before, on, senton, sentbefore
# and to fix bug in i/o engine
# INSTALL -- to enhance installation documentation
# README -- to add new platforms to list of tested platforms
# Todo -- to update entries with current status
#
# Revision 19991216.9 2000/03/02 19:56:06 dkernen
#
# Modified Files:
# Changes -- to document changes
# IMAPClient.pm -- to add run and run_and_tag methods and to add documentation, also to
# fix bug in folders method when optional arg is supplied
# INSTALL -- to improve install instructions
# README -- to add to list of IMAP servers against which this module has been used successfully
#
# Revision 19991216.8 2000/01/12 18:58:00 dkernen
# *** empty log message ***
#
# Revision 19991216.7 2000/01/12 17:49:40 dkernen
#
# Modified Files: Changes IMAPClient.pm -- to fix problem in subscribe
# method when subscribing to folders with embedded spaces in name and updated
# change log to document same
#
# Revision 19991216.6 1999/12/28 13:56:35 dkernen
# Created v1.08. Added acl methods.
#
# Revision 19991216.5 1999/12/16 17:18:32 dkernen
# Bring up to same level
#
# Revision 19991216.2 1999/12/16 17:17:17 dkernen
# Bring up to same level
#
# Revision 19991216.1 1999/12/16 17:16:16 dkernen
# Bring up to same level
#
# Revision 19991129.6 1999/12/16 17:13:56 dkernen
# Incorporate changes for exists method performance enhancement
#
# Revision 19991129.5 1999/12/15 21:39:07 dkernen
# Made performance enhancements to login and exists methods.
#
# Revision 19991129.4 1999/12/10 21:51:05 dkernen
# Fix my brain-damaged select operator.
#
# Revision 19991129.3 1999/12/07 16:13:23 dkernen
# Added timeout feature to IMAPClient.pm and documented same in pod,
# fixed bug in Makefile.PL when specifying PREFIX directive,
# and updated change log accordingly.
#
# Revision 19991129.2 1999/12/01 22:11:03 dkernen
# Enhance support for UID and add tests to t/basic for same
#
# Revision 19991129.1 1999/11/30 20:36:24 dkernen
# Updated DESTROY to turn off spurious warnings
#
# Revision 19991129.0 1999/11/30 15:50:02 dkernen
# Incorporated bug fixes from Scott Wilson
#
|