From 2aa841e7e0042540a2821bc357c2cc95578ae4b9 Mon Sep 17 00:00:00 2001 From: profiteroles Date: Wed, 8 May 2019 01:22:55 -0700 Subject: [PATCH] 0.1.6 Better menus, fix UTF-8 bug --- .DS_Store | Bin 14340 -> 14340 bytes CHANGELOG.md | 6 +- MainMenu.nib/designable.nib | 18 + MainMenu.nib/keyedobjects.nib | Bin 42450 -> 43082 bytes Minat.php | 67 +- Parallel/.DS_Store | Bin 0 -> 6148 bytes Parallel/Parallel.php | 4 + Parallel/parallel | 3571 +++++++++++++++++++-------------- README.md | 2 +- bin/{keys => .DS_Store} | Bin 8560 -> 6148 bytes test | 0 version.txt | 2 +- 12 files changed, 2135 insertions(+), 1535 deletions(-) create mode 100644 Parallel/.DS_Store rename bin/{keys => .DS_Store} (62%) mode change 100755 => 100644 delete mode 100644 test diff --git a/.DS_Store b/.DS_Store index f90eb784e0bd07f4c3c1780ea97d4ed73953cf30..14c6eda06da9229f5438ed5287018d50071c1fae 100644 GIT binary patch delta 2250 zcmeH|O>7%g5XWb1H{M<1^f_^ywVfuLxNhCxq;_IAZj&@lQXwiD5Ri5_!zW{>7qd_1p1PzAS{w1Qvcy}|CF>uk`}r5`T{-M*)?2vy zm6bY&vSZgk{sgIBkfqE}GA$?KsWE9TMW4=)m+pXG?A6Lzd!y6c+TPjSS1?s=CtNjW z8DEf7awIB^W@IrvGZ9WrNpVq*Pal&-DV~-elchP*X5>BOul2V+eb+f#FKTT^w^Yw|MmK5s@xyzLz2n^Vu8T`-z;9^43N#{vX54`d*obay#l7f7A0EJ7 z?8AN>z$5q&j^HSc;R&2Z86U@4Ok)nu;1WKKFW^PIgqQI(yn-uu4OP63@8SE(6_-<4 z=FQ42SCipB3%C0(?(P4<{fkNswz;~-QrqBkdwl!4LP~zuc>ZqaM=1g66r)v<7z-4) z%`VuR8Cp2P6hAqaeK$+-5-fRL_InwI=t{meyO*UziN56P-~tR~N4Ax`LGA!c=@LW1 zn%4sNaJ>wrNGb}pI^NpX&v68_IQv^82tI{n&#CF+>q)00wdYgE)*6cnl};QOaS4a+t*^#xaAZa1pbV$20gWK96Vd z9A3azD3w=>T;5bHZjFSaVs*XeEuV$CmK93bwA` zzbgtofg9B3pQxJJC?^G*t~;b;g^RU;4zEWD1U4&&($dt;im9n+B$0@MI@z>_x^Hi) zy-s#p7Zt4QLm$xadWcXdi^mchf^YI9XM7LSR!SC|AtFF@OK7%)M*G2R3C;grXjHWQ Pj;hi7t3kc9)2ROwb+|jf delta 367 zcmZoEXepTB&!{#rAWY8T4g&)N3xgg*IzuKyNp8N2OG;@;G6TbnAL_~y>>Dqdu}^%! zyP2JXg@aLYGmk(QGgG0=VAjxEv zFu7V`mZ*t|nT~>?nNh8dLbaiVnYoUFrJ3nuEk&Enm5SFHnLe3p4pQc11v-T#RF7?P vqK1e(gb6gCnIQ=n8hHg7hQZ1CxdlKG28JX9Qar=Px|!YJ8_Q+^Rd!|o7`1PV diff --git a/CHANGELOG.md b/CHANGELOG.md index 5ba0ac3..90660f4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,9 +1,9 @@ # Changelog All notable changes to this project will be documented in this file. -## [0.1.5.3] -- Preferences window - +## [0.1.6] +- Preferences, version, console menu items +- Fix UTF-8 character bug ## [0.1.5] - Add version check diff --git a/MainMenu.nib/designable.nib b/MainMenu.nib/designable.nib index 85e3e14..ddedaac 100644 --- a/MainMenu.nib/designable.nib +++ b/MainMenu.nib/designable.nib @@ -164,6 +164,12 @@ Gw + + + + + + @@ -483,6 +489,12 @@ Gw + + + + + + @@ -708,5 +720,11 @@ Gw + + + + + + diff --git a/MainMenu.nib/keyedobjects.nib b/MainMenu.nib/keyedobjects.nib index 20f9b37553247a36fee785ea6c6adcab999f92a5..524b4f3d62cd58b5c09c387198e2a9736e8b2774 100644 GIT binary patch delta 25463 zcmeIacX$&=6F7W(r*e{Q*%;HCalzfj20{()y<6^GmgR2AmgI(P=~gBx1PDP11VS~v z1ryUdq4&@`gcf>-(BZcy*~TQidEe*xe&6%`^Z8^MZf9m^XJ==2XXftsLHxk)_@u7H z72Y4;_i#})Vr-1W`eF8%1Llf(Vm{bU*c@yNwj0}z9m7szH?cplTiAW<4fYmT03PTH zx`Cd+0XTvIzzYloBY`gn1R)?2M1gpa4AMb1$N>V72ZW#ml!6LS1*(ApPyhlA&|}SD zBA5hz06&7Cz#K471?GcAU@=$%R)Al@I&cwO0++!R@CW!4JOZ!4YaGW3+yb}8JL7%v zez+|@2p^0O!-wOea9=zekH8c0R6GsO!-aS`F2*(ZczhP#gs;MX#kb&l@k99U_(}Xc zei^@p|B1gNm>`H?5oUxr(TT7ox)7?KL@&aT7(h4??t}+1h!{$YAbbfwY&{V`gb<-b z6cJ4%5PTw;NFmaRQlg9~Cn|_~qJdBnYT{dBJn=p81MwpJBEQVo$)hc24ewZIb#Lm z7seXKTE;rYcE(=DKE{5=?~G%NR_re9zU+Q%XSNI5lkLSG%vOzN`?4e1QS5kj zE?dCPV;8cE*v0G;b}74zUCEZRYuL5y2DXyj$R5kqv&XT&V^3oL$ezOfnLUF&m)*o( z#9qu^!QR5&%HGD_%|66F!#>OYgZ+U0jQx=$NDGojb|$-%y~%#0J?Tk)Mf#EcWB?gR z#*ndOI+>v&Gs#>spA?Z|QbN{|W5`BwEcp$oA+@BAoIp+_4df5xG;%sQo18-~AUBbl z$t~nA@(g*FJV%}OXOwp3i$_lmApn?CvT89$v??k7@NFJ-XR~6&&a>XH{^Tr z1Bc*Pa5{5rIDI&MIrbcPjt6H5NA(qFBqx9q$O+$nYEC0EUDAdx-lx_ZasS_Z;^;_cHey_d53$_cr%F_W}1g_XYPa z?rXDe%sW{C>=kggcw+Gs^k+`6cxLh3;)TUuOewfvc)%Qk@^rV z5T9)DBIhxtuCx*wPLtamu^+G>u_+WujiLgnAZj55q8bQ%)x_Yit@e9s3!Zfz8BbVY3apxGrXMu_kODHXmDn zSsOlZdv$5SR%2_hmDpPJy&l_uZNxTVn+?up*Huff<=9qi1){PT-P?}sK;JvDT^TX_ z5UHSC#4jErqA&;=As9Q@Ic>b4iZjCl`xq5Wfi`S%pNLFOr_e z9w3GuBC2gHJ;EMiPq3$0Gxi)&YQb(GYOkxH~8|JEG>Z*=!97VYtR|kfG&o|ya0#ppa<$dL?V_qf$o^gDb(Bx^ag!E zU(gTOg8sk`*c*~9V>>$mXLR2MwYvg0;0`=MKf`*2>7h94f3 zguVg;Q)2khl6+B_6^H6;g;BQ0!7v0j9E@lgZdKn&H41#4g&?Zrg1j zMsd*pJB~SG1Arg!&y3**O3EZseuY3NY61b6%V&2?a6up#b!UWY0zrQtN0@OO5mbN5 zp6W?C)v5d(IBREP&sx^sszB#v9gTeCyHw2A;qGy{6JAz*?f=y5_R;%GrGmP7AOmD! zE@&A32Bv*~@-E1oN8=hi?HyF_S|_-5deP*HKmjNOMWC2+q&z7v%7^l>CNT_)I|?)S5&U;Ee@(+j>)dsQ#bRY%tPPA)12_&B5tqf;>@~kx)lEYS7q9XCM|h&_u^1 zMlH}G6$+5l&Iekf_}pELOBRd+DUu2Ft|FpiTKBIXfq7_ z26lp7h?U)757-O#f&JhBwh2w+VQ>T-1;2x1XvLnuHe;K?X>bO)ue0DBYQNCJ95x^6q~_4J%_N3f*wlsKHn;=sf_vaTctAx_F%+N5qy&_Rayo}pX+C!5 zb4vxDfT!3Ma0K;!1oijQ(AU|`=?gXpya8`%8-%z$0$#S-pbBT_f7&3Nff#7DK{yu_ z;pT=-&b>Od8yDQtq$Gx0&V5>YI*T}Kvv-ei8@vnFjCaGk(|zH+P+zMIZZ5+H^~c`f zcDOz600`U>dk=7WY2X8JC)^n@a2M2*8z{!z!Cl-F_X2F(8}~6xahb1bTNT#$5PDTu zSz9eDo-=aGo>Xgmf@SrP7qCm_E02A*4Azc#+h@Fbe=PUgL7#^c)h z{vKGF;poPb8HUBV~e6LAUt9inZGEyO2bi}CN#R4+#~C*ubE2Xsxrr-BFgG;9}A!3X#ZY?Gn4 zN6FCH$VcNpP{owf1;o=lunC`!FQAnKH@VoY_#%8Uz64*2daps(FGx*};?0IF9!cF= z@YVPld@a5XVXntF;6A9AP55Smi)Uizt@t*4JH7+8{Dv@h;k)rYhDn|Qs(t9rHhe#h z7A2Z+zFb-?E~La%1?~5(@x%BL{3x>Io-$K|B+jHB$MEAuchTz1Olb4)WB3WorJalk z^b~#?c|F=g@R4~D6pH5KXYjN5In0H=ZHV{scfLT6c_~#&Ihjzd;C~pYM+xdARq|+o z7-319@T-Q6UOffZ@f+=)igqx9Vlmx#6Lb0J?MwJA{5F0Ezl-0)@1x;7z#n2C@kjV$ z{0X)me~LucjK4tt`U{EV6)3<~;&0G23>o+??mfL>!aopzU?BhGSt_cNHQ^r#jH;$; znh2aAs9I_aRi9(k39XXPUB_phfgp{G-rfMcT|b!ug4b#aHhbG;btY`kN(?GCI#_|U zu8HXUH+N2SYj-b7+P$RF4$J6WPT)pHiQa@Q!I(#2L|>vGRYOq}oJaI0>=WogaLhd!p?QW=#wx&{oHa zO=((pHN-Hqt2ylxXKpqUwT=Q8h_8v!25(=NPL70s6X8fZD72j+0*N3)sc#PuZ1~34 zyIU9$o^H|wdjGe8h#(@34*#&PR|nz5wu;Qc&t7Guj;%!0lPEnkIax8--F9$;iFPWH zhNuOW6<5&I<`bz#&*^fB$S|(yheRfkWm?mS#cXT^kwfI-K7;_pc^=RgQGkAnh+H)J z5Gk!`hlBo+D3BJ4JpL49NV)!Y=;(SR> zqNu#0OduCE5z{;D35c1kj(Sn62S?pE5%Y-o!~$X=v4~h~I2zbH_cv+@wHSi3)M&K6 zqDA5=qoXC3VN(|n%ZU}lFT_fsnOaI6rS3t%had~tE24#1O{_uW))MQGB-SIM8N>!+ zBQcZMOl%>xf+Au&x_%>e61xnMK`OJo2zDQ_pEy7qG@J_ZcRot|Ze%~ON+y?-qqBje zN{V*C#8J%U1n~*@q+xWhdr2G5=McdQ)Nj;kY8iFJ#N{Py>N4UoafSGUxJq0jt`j$i zo5Y{QE#fw{hFVW;pf*uksGZa~)I!GNdo`(?cEk@4gA)dD&J~tXUeuQ}aJ-GX* zXT)=)1hgc=<)ZQ?;u+?0zJ0)d84+Ki0n@|XP7fDbMQp{Rk*kSD1RO#|15kXH}p^# zUC`By7Cxf3&PZSCcthR&vK>cHs3=*H-WM7tdU?J$a#(I1;? zc!c%ox(n=^kn~)tnes zoG*$mGUBM(^{f?%F_P9Wgyc&jS!3NX%s9q9)IO>?gT}Otl^2PmvVZ9ki72$aOAqP* z)tt&NlGNDxmzDi}e5(IA*Z=zfQ*h7r-VReKRC9b~W)3n#6%}P7TCo3lN@o(P)&<27 zpi5|+(?zXwdW=>Bo)H`7FxVN(|~${AvYgi*n$ zWJnn@hMYP-FA;6a^5*BP4gjMxg1*fv2V6p7^>^>I8y!kx5z30*L33wKtvS*p(#u5o0aEnIqV z|EjGf6eNo!jHT_e_=CDaH75m@No1n-Z4%J+M#bHvc7!zZ1G_4h1oK|Gv+otsl;|$~6 zXA1d%dO+PbDr9hevD~PTDx{I;7*~)+-lrb6Y2-Bwh50NQ*BLh$HyM92ZZU2%?lA5$ z?lJB&9xxs<9x)y>o=}gdr_^)m1@(%0OMQRfpLb` zaN6>ltiP!zWbZziyuX<*gkfCI%uY<}_Fi66e^Jf+z$$rs?H3tqMd``x)sFIpdW{$h zlvLEk3;zwrK8Weij`W^-hqN_LAd`#YtG|e45&_el>CuJ+0Y-f^q(P!e2RC78XVF~55{f!rVS=6e3mGu{O z)ySlAH^PiVSAtPjP0E0nq&$LQHU;%+S zZA?Rqt1cg{x`O{ehSA&T_LxOXDN{!5`b5FX90E&2r&yPcEBznckHKCskqK`{vxcA( z)tnZBc8|6(=!g+t_#gUhWgkVem}5KOcY(l$YR)p^$4N!i#geL_viQ({Co-NnfjO}Q zk?vM#Eq60Kj_v2(W(wP_RJ-7&FsF7v=>-4_D% z>0_7>*GFY^l*~oU#q>n?gTR*hEtOw^BAw_&Z1gqEsQ^ z2%I2rhQJj9_b*x==A2e}t!Hkax$bM4W_t+i=>1#|<0gY|aEb5sg%P*m?qL4b0e1id zj)t=MUKwAoKd8IU>`!ZlZ3gHcJ52;{TD2$XRZBw~m#vH8TD*hfXY0Ei^5SQZZU(o6 z{{(sCGe{4EJi+n5%+h`4edfc@XK5e==;LKLmSEF5OAndP=~?oEz`JcZzC;@u<}2oF z<{Rc)<~!zl<_G3S2z($I48afxhC(nLf{_q>4T0|$HVe%ACMmF3CXNT1q%eq{A#2kN zRprU#s$zK+9SD~hmHO|d9})SR=m*ks{hvkO)@irTI{k|7)QVp&kjiaoYwl&V&c=yT zA$!uc9JaLc-0w5=VN`Rb2|2z>f{q9Oobk49oj$`G(T*1+kQIFyPi0gUme*&9qtKSk z)L|5gC;Ur)Lq9_sO*LoJi4WT#MdfI( z_+RWjD->PfpQ~0N1n3h$+k152Pm~J8GIX#i7Z~Tb)%df*S+TUX1was_YE?H@0*d*u z_^d=$5(L2zghCMh1+8L*wrW+TiT^+o`ys~Oq6MWQbcCxANo@lKGSNS#sU1206S4~V zsIX7iQIeYfie2^z8zDy^zZxj0D3%M#P@3?+Nlea?v#L8vOa(!-@e@UhEE(BHk+7&u zPSvb>T24_A#I%V?h0=yBiUlEvg&_V*5|Xz{NM~X*+9aVkq#JxWy#P=bf>LCHP2xfR ztX=(CZK#tzLrp*~2!$Fe+A;s_Ak}(~V*P}!>BfP!o}(Z@6N^5H#;pJyXfcj55wm7Z zXU(C9nFv90+c4+R!<^4TcT*rp|DqRQ{bce2tYxg_v?Wh6d4V(tQVq>1JvusS(=MSM zVKr+_2ZT%rGH3{`p9AAjm-zn{Av@Q|ze2v5U2b zwVkz(`VE3y1Oq{-(HXK1pimI&AnOq8FzW~lrPtB+M+kukf+C1gbaaOK^MD3xYwJXx zHqBO!X`=J!u^?2QC?LcvUp;dr0h$ZMa209+Q2eivaZk)$+1Skb<;Wj2?Y6Q z@0%`>lz(BDiTXB9H0w{+EhC~y_Jt4>phJFivADQgg;qm+`QOj^ty_8%e#ejw>ioYP z4cqzzMXcBDebW2k661&i=s-KYwY8N?Y(u0H1C`cK)t0uKNnBG@I#iXO;OBC#XTNw$R%2<`8rR6veZmsYSK1WgAC zWKndw@+A1wKiit!nMQ#?4nYkSa1N#CP04w>THq0?K6uRTO6Og$P3)c+O3br+W2+#j zCaD1w)(P~c%MYqJX$o)euiR~Y1~;6;zL2tKTesz7P|CiD?F4ZkH_T3V@7gW~>;&80 z$T`|o*BP#+caRX%hw?RC^jm~;*%5~CGI{}p zVOfS#2jRuAV@<445a_6YD^^xuJ=g#?fvsR8*bKHCbD}5}^C>6FPC$Z8WGAtcQL)D= zIvdK)ptGUuEIJ#?oB#o&nbbg_g+NVlIg}ga2EjMf0_%abXbFT;m?1vX#Y~9o5ZfD@ z1rbl*WEOwjE=l4BTVj+XS~laTfXpHk5&MEZF~saDBiLyO#v9zSdVHD-aF?wxHlb+m zL_>O3-wsXp+0fX8Y``SL#H_y2?frs#Y^|{gnXSpR?)9vYN(!YSnJhpcMSfpUTqaAD z77N6MWugu$3vRO~7}1a~`N8lyt5=84?ywEUrWgpO7+kaMJ_#QGfj!OGR1CpSbZ4DA zbVgfB+KhMXrG-7)2p2l!Sy*q%zCN!(^HFhU=KUkoNtzlr?+rr<65{&81PPhz%49O{cn|MT7FE|C*a+U&U+L z*U-0ueUtqwb`!(R#WM0ZL(PLf_PE2sW7bv-kZSGyXuZ2!eIAP&OMK z8v7yI(Xp?x@3LhTvV4yUs8ruUu+;cjOBs+@sqc|} zM#5dvT1|z@R;JEnzd#WGn&u^$Bnyq>D*GzQMZ!Kxnp4OUAeXS5W*dzSeOA%`T$ZjF zGGw^B?VzuQG@Qm;a8-vqFlmYVuwRg!@Xhvq5ZMa!W8`cFB|C+GmK7$ukX`XTG`(gB zexal%aAR_q>_I1oAz0ZVDNOdI=u|Muk&?D(C?t#K31z)o)2*s6CZWNzQO;R4kUxIW;AQ)A_~xNYdVmc0>OIHIA>_u=#SyCU;p5LN%)cRbi%KV4x(gC zE7Ei}lGN1CD2)@2aLqzVKoV`Hw)`UtND2_LF$)O6R=VT40sT~T3CkIjYc!SHnQHbf zkcDIsU2I3MMzRd4U8hc!$Wd;mPyh;92ecF&C=BI`6bkPlv|np*w^h*o*!!yne^VtVF*1nKxWJU}Z^HaLD zdjj@e@>^gui^$L%Fhq#@bZ9$3es5~q0l^`IQq;dg+kSGYsSTN?BZjpiyAEwH$eE@# zwAy|*JQDRtZSRk4BIlXfjzjQ>Hp7reAOMK5_ciE4Z$t6pdUhT2Z9q2oHBk+ zLU5YGviONXsLCNllt(+8l-9p!H;iVlL%k)rjoeP|Aa|JREg{Z^I1Azo^l38@yD^WI zR#xO5axb}$+)o}L50ZutgawN{L7pT}8S)Ap%ptfA!3_wI!TPgBQ+O8m-9^K?hixJs zkPp+t^U;yGxS&`hO->e+Rf%Nu%6rjRlqoWHNq@fIikXk#A9XUyVr= z9Xuol;~00h5Ilk4g=z0b=h02xMrBg(#~cQSX>vCl^wZ{Uo@ZwBbt|>MnRb$M)}w@TFl|sZ(V8qTmeU3^#H14uTK# zzW$4Lh4VFSSB#t)?Ft0%X`@2(WH2lHs>4V_IH5**I0kXc|9P*&i7@STP!F-3IC`(c z;nRB^PI8C64i4J)I!_^P0dXGM^+Md7a$};s4vrgkmkm^9qAd&uBX^*I+0yESmJmQg zdr3K=^^SEYsYWY(5w;kq%2I3@U517I0^E`KS8+sWjj!f#P@(lv^u3-_!YM`Svzg>T z9If_K)DY9SA&zb^5l3!Dx5tstZf~s(4S}kbkR#;C=sReGb=;sUA2jkG^{bpQpXyg3 z&ZUe6tp6xor7PVG_w&6Bj^Yjq#oEfzo2D%X;+@bruf|y5L2uyOmlb=dsjdTUJ6j7o z+P1Fj7i}#||JK3@X>Gx=zqOD}V5W+LN=MOn&{h`jiaJdSr_(rvsN$f#QyPpjza6SO zy@|F$r6=Mti6H;W&`aB)d!kKrKC+cxhHD0@w$6JS_vQt3ZF|&zq`S7AZeJ=OyFyY{ zEUf!7<<0GowlrZIbQ&=hn*5!1?sR}^Xz?FRGD0PJpI5xHW7@<@nOaUDfg=RgQO-dQ zIwKTA+yUZ_D6A+z)z0EVQMeeL^TqNJMsvwI%K6=3ThUW>lymGK<+g2<4s%Y@ltd6m zhhs#kGcu}lc#@7-2;@~#6tfu7J{OE~G#BSNhfo$DO_&QpNSB~Iy77QNqLm_}f^!8y zT!uJWNsd{FoQkGr%vE=wREa3vL~vJWN*)L@Lnf#eB}!;o?WAO!y9nea#JvzewzNtd zhsyL!C422Ka?T?Ja~tB`2qw7##XRJnx*=|0Hk`y42w)doQ8@^KB+=*64iL8y#9IV# zhz1yf0Mg|mX?d|2>0k$_o0tt3AgH}G)KCOv7+=||N2}2z{zR>8)ViN;9Zt7yuk3|P z7(G>oxaPEgg%BT!8ZukOOGlADkw-=OukuL*=cy|lu# zPYZDw_1_1fuc7<*L+CkHeI$l-Y5V%-U~Sk>{(+5(V`p-m5q2is6o|01<&r{lSZ+N# zw@I4C=X%g135GcOIA&MT{#S^i$|(|Qej5<;BiDxpLX<)gkm04&!OJKI#&zyc)W;); zhok#Rs0d!tj+4zDMdP5yWg=;u2wCreCY;+`e}wZE;?d}Sas{10ZbuSuLue%QL`^J> zG(~1tWD+>VjiejU-FVcHEu%xcZ4us2@+7XJQO6_do9I#V5hOaBqX@sT_R5qM7JVAk zD{eAP(+A>7bZ1Xwb~eV&n9bY_y1^OZDRhIA+`i3ou@;~X1axCM-9wtO2di=vkf*~0 zt?|^h(J=0C3lJ|KAf933#5h)eSzH;ajice)0GV&Nr8G^Xs98qH?xwji=0?KBGLf{e zoHj`v1oe(vL1Q4b%%NGlC3kFRaXwa49qj_jF1f5s|KW-rZ~r>o#-(xT07ep9qS+(&jK1nKo6%9wfzfE%vIc_ zG^{JcWi)xK>RzoH^q#wtZa~JNif-_&Zd0vaxvS|0cZk=}4OP`ntr#n~8|Vh~{8$~` z&|GcPHlf5Hh^K963O3LzDNyUbu*A5<-GxA3LA(J0CJ9j%uzj)0z)=m9L|2QG3abnX?`BM8HZ8oLCOJxJmrCxUWk z5dRi6AYUnL&rKOE*GVv)`;hwxh05-6pKzaYpP~BPXo0j89cs`+T*w_!nGl}{@d*(B z&JbEVfOyG$WvHm_s(MKuVbHdW`v#0(X{9$l3Dbfq`01xa-k?V%Y`{I-58TJoQSE&V zs*^{>`>2X(IV#?4FC1lb=~y~StU#r9biv$M#`hhI=7?WV#nV5EmQ-}r5-Kn0P#(f~ zi0ThIR1Yv7p-lJR64s2zC`D<^Dl(p+)Ei2i5i3z<3T2jvW|aMCPq&~LOG~&%#=;6WB@Y2@3Cb<&HJX ztsA1+_E{n9QB?6p7XhB7&VN=2cn=lx{7dN-It>54^u<_@)%Twj62>Ael+E`sCFTwH zRX!>@XNF3MQBLJ=X(VF^6@@ZT#9)CjgtFKex}rmKrbs0noj^wq`ecHRlFyCXe{>o@ zZaM@&fR0lX#YNF@6!oV#=*dSOWlfGp={i$dQRu&I z*CL8mlrLPy0zIT9pM5A4jOcAFz(IQQ=|kW4G*)~dH8Flvra#7Sy4By9v=2nz^#3AF zDQOCYb5Uv{iO#H|f10!jDOBqRZNBJuyh)kRH;U;YWuhZ{rnnYFVQ;iQYu6>@C(%(7 z=@L>c75aTi6ENu#${o?FWR6q`-IJq7;f!izZEj6#5z>(V+r~!qsYLh7*5?0ZV-xt_ ztj+&oY|!J|Wb5PG`2TNtDB~mSJ*fY0o?(y6|9|=nyGi3MaHGZ(_AMUjRKT-nwpeBH zt3`{&YKt`%YYnALDNc=RS=Kla{|XXfNJt=20f|aTNFgDEgd7r8kf?@44J2wIQ3r`J zkWfIP9uf_ZP(ni0GF-DAWLn*}x?^?M>Ymkos|QA(&O3umozoh2;hhKL=g5JZr5ln`X5o9zONAl5&F^b3%vds8O zjEUq_6j)wHu0}7vpd+;hQGE6)dcnm*@+D_G=Qs4;i9MWsoCE0H6Tfp#pm$H4L+_rr zg5ErF6TNxj9_JzFiNRJ6Rjbh}A2xEgaJO@JqBlP5NAG($$~}(W_i&bb0ln|xD)$EW zPwq=I+|10(#;mJZce9>mz0ESrL}oIxsb;gyR+w!tJ7{*&>`$|2W*^PD=H1Qh%pJ@f z%?Fq}o4cC3n|qoMH1{zdZ2pz`F!K@Sqs)`c1?EEY0`p??QuA{23iCRZdA+$3*|eGF zv(4w4&of_OzQ}y3`Ev6$<{Qm7n{PGWZhpu7nFZUz+QQYs-NMtt+hUN#D2ve+z83x# zffgYaSr$bWl@?lyNfuKr=2;xFIAQUe*PAzh=gf2Ex$!)BUOaE!Al?w(SG;JRl&9p4 zNAI3kirx@$jCYZDhxd@Dddz#ud(Qid_mcOT_tp}#w6?UjbhR90Il?l~GQ={>GQu*) zvdB_mDYw*H{%F}`*=)Jqa--#D%dM8%Eq}AzZ+Y7Cp5-$u%&Lo(ot3xMAgdu(L#@KB zqOJH=8CF?VIaUHIp;eicy#F8lul2vz|Fs=v$F{Sw>tknU=Vdp{&QE0*Y?p4AX_sx6 zYnNx&U^m%rj@?STRdy|Qo9&L+ow2)NchBy*J!Wra-^ISKy@&l^`%(6M`%HVGeZ767 z{T%xy`}y_@?HAiGwO?u9Y`??)fc;_nqxQ$_|Fpktf7kxL{X++aLl1}E4z><<4h{~( z9Y#8Q?cnR+?-1o6aL9Kka!{2xlsQy6C>+K*OmLXwFxlY;haVkgIm~ld?y%Bfl|zfe zeuv`@9~=os8^=D5ZjOT-hd2&(9PT*MF~~8*G0ZX9F~?EhD0Cd-*yuRkah~H+#|@4L z91l4jas1u!xZ`!ln~t{}?>OEYFk(RHfWiS)15^XX512Aw`GDO6E)KZk#B#D%IgN6P zaY}V6aFRM{oODj(oW?s%beiNe+35$TDNa+JraArWG}CFe(_E*8PK%wEIxTnF=XA{J zg40c>56+k~?#yszIg`$voclW4I@>urI1g}kc6N1kcaC@FJ104(I;T5lIA=NMIOjQ! zah~VAz%(D|A33+I>4ubtmIzjOZJg1InVdb;#>>FZ+a zV&^i%CEF#}CC^3ZB62BoDRwD!5xZ2lRJ!P0esJ0Ea@pm+EADFJ>f}1yHOw`_mG7G5 zn&O(~n&Fz|n&T>P&37$uEp@GTRk~8HYS*!@6I`de&U0Pvy2f?8>mAp7t`A%vs$3tt zK6QQW`j_h~*Vk@VZvJi&Zc%PAZhW^Sw-mQDw+y!|H?do#o6N1st=et2+g!JKZu8w1 zx-E8F>bBf%h1*WI+inls9=Sbnd*=4S?Ju`iZg1Q^y0hIQ+*92J?&a=k_o?nn+}F4t zazEmJ!u^!{8TWJU7u+woUva1%_yXu|$2M^2x_b~IY_OS8j>e1b!r$?+unupM% z+@soKhQ}RDe3P`mtmi$? z*DBAqp6@+BdI2xO%gU>VS1+$VUj4kBy?nd|dkyg#?G@*h;+5-F>{a7Mc}?_M>b1>l zpVvXJ!(KZh81B(XA2Wkh-9k_eo*?}*-ac?eqVZu=FDDN2W zIPZ9GzIT#$ig%`Wws)>~p0~ui#=G8I=}md7zVX(2>%G7Ap6$Kbd#(3+?~UG@z0Z3; z@_yp|%=?A+OCK{I8=w9@1AIpMeC^}wTS^|$kP@E_ps>>ubK=bz@E?=SJ6H#-{Qa7|D^vT|5yHR{Z;S%KL&IU@C(Qa7!$B8;Ap_HfD-|y z0-grE4YUdD6*xFBB9I@L8(17D3mhLfHLxjgZQ!=RbLiy@ao{s_4iawFtzsB@@msC%eq=)h2)(7~Z!g$@fH5gHhp7@8cK8k!!O87c}b z2rUX76WSO$F7&(5^`RR>H-~Ns-4?nd^taGmp?gAah29Ch7y2OdQRtJl0=d<`6a@%vlxY8s;80EG#W7BP=T{Crl6~3=@Tk!={E!3;Q{2M%b*dIbn0d=7lW? z+Y`1g>_FI|up?o=haC?)8Fn?C7j6}99c~leHN1Ox&+y*ieZy_T9m9RX2Zw(ZJ}lfn zJRv+WJUKiyJUu)!JUcu$JTE*y{F`uXxIX;b@Co7Hg?}GDBV08rd~f*v@Ppxp!;gj^ z3qKKlD*R0Nx$v9ee}%sae-r*L{6hpgf*WBT!HaN<@QCn=@QxT1F(hJWL_kDF#MlT; zgf2oK@omI}h=~!CA|^+)M68Ke7qKB?Q^b~tZ4tX8_D0-}xEpal;$g(&h^Ga#dtYz0v!l4@Mt}{yqA5^xf$DF`O8)7>gLo zm`*V^F<73vutc%$Y zvnggv%=Va_F?(Y6#TkNq~bIrdcS+1T^37h|u)UW--ThkNYd`Rot7ncX1!%@pxuDJDwA78}AW6Fn&<{koeK@q4A0FDe>v?S@F5?!uW#t zqIiA$`1pzOlj05WQ{sP$U#*H?8-FJLeEh}u%kfv^Z^Zu@|2F=8f?a}Rf>VM^f@^|% zf=7Z^f_FkpLR!{5h0z(34C%D<7wNi- zOiq*~RwdRZj!CRfR3*a1iHXY+S0pwk{+hTtab4nu#65}E6K^KoPQ06VKk-rGlf?H) zJ(GGT^-JoXWS=x3$vJ6gQlcs;IVmkEBPlB>Hz_ZvDrr{IoTR3t`AG|tmLx4tTA8#e zsU>N5(($BINoSMJCtXjvoAe;*aniG-7s=MiHp$(RdnETt?wf3z?2{au9G{$+oSdAR zoROTBEJ+@pJTdwEWJB_g$v-7ePhOCGB>DH`0^8JsdSWq8WSl+h`EDX}SKDdLpM6j@4DN^Q!R6kW=ilyxZ^ zQZ}V*N!gyVGi6W8zLWzgM^i4QTuHf>awFwI%F~n=DX&uAr1nbfn`)bCm+F}6oa&nT zb*gV_ZmKXgv?Bsq0fWrfx~yp1L!2ck15MBdJ$XucqEe zy_I@5^;znNG?2zfW2bS`EYd8~+|xYMywe7y4M`i8HXHue6tGuhZV9_fGGZ-ap+w-7#I| zobHo-Rq3rpwdS>4x+l)2F6SPoI&#D1CkU#`MkU+tPQWpG&`+en0(D z`qT9189g$3XY|SFm(f4NA!9&>ONML4;Ec44%#7@e+>E>oVTLH9FrzF(lQA`8TE@>A zvohvnY|1#4aU|nd#>tG+86Pw8Od^w+$yQ}@GOaUhGP`AV&$Q2s%FN9aWfo` zcv&u4-dQ8Ee6s?wg0e!g;c(d<96 zuVvrJzLk9^hn>?sr)N&@oPIg|bB5-GnP(%$c3j zl(QgbQO?tx7dbC;Ugx~a`Iw96GILqEWUiSi*CN+4*E-iGw`;CZO&bl+mgE`cYW@r+^xCWb9dyP6<7!?1)T()1ziQ* z1w9451v!E|fk;p!C=rwkP{K@5FHi~8g0TXvV3J^}V7g$YV2+?ka7J)Wa8YnYpt>fw zA-E;DBe*MgAb2czDtIgSkO%UJyn%T>c|-Ds<&DVuI?pdJFfTYSERUa8mRFTmo2STY z$eWz^L*CT9>3K8qmgFtZ`z5bAZ$sXuyv=#L^Y-N(%sVW^g-jt^ND8?^b0JUIS=dF` zUD#9TBy<;g3I_^@2!{%X3r7mWRKi$cypS(U7G?=^gaV;ZC=yl*8->$_M}^0PCxxek zXN4DpmxWh_*M&EQxAO7)LHR@Shvg5?ADKTo-#LG*dKNG)L4VnlD-+S}i&(IxD&^dMNr>016ld>;g`KUBRG&AqB$Ri;d zs7F!nqJBkoMUF+zMQ%l&Mcze&i-s1BDEhj{uPCr6xJXc>E}CAnz35Ugx7fLOL~(Ml zpjcD9w0KYPvEn~Vu#)a2JxT_Yc$W+-8By|eiC;-{NlZy>NkU0RNo9$uwgi?;D*3Tw ze#wfG%_TcZ_LrP5xma?gI=6Iw>B7>*rAteJ{Rj@czoGq>v z8^k|~e-cj@&k)ZNuN1Emw}`ij&xo&yAB#UoEG3;JHj-|V9uf!15Xmsf2+1hPXi2Oj zL6Rs*mZVCG(OUz>k_w4b(kRhLbdql+6C^)LmPnRMevzz_v`F?y&PdKnE=sOQu1X$C zK33orj0$!Ir=m}Vr>ercVo=3b6~ih*D^e>mDzYkaEAlGpD#lfeub5adsbX@)yo!Yt ziz}8^EU(y5vAJSf#cvfSD=t;MsCZXtR@uF>S7qPI{*^;3!zv>xqbg%76DqSRODfAM zC6&@js`C3vL*uPRkHIeWm`=Kxv3HT$(49Nvota(lOEo=@jWa=|bre>2m1?=>h2>=@IEM z=}GBD=>zFw=~L+o=_?sWW+tfy0QLd5eDtSP7|swu4z*Qjg0tC?K$W6e)Bt7^8^ z?5NpQv$y7!s^)pk%bGVe?`!R9y=r}Ghtv+Mji}A2&8p3*&8rpF*41iib+zBtPOSZ* zc5dzb+C{ZXYd6&Hsoh_DsP<^><=T6-4{M*)KCc6HL>;S+Q^%|8RoAz!f1N{}cirH+ zp>-qbg6k6MlIl|HGU^m{y1H-cCf0plH?MAW-Ilstb$jYm`|A$X9j&`o_o(jG81pfm z#`IKpDZCYf6hjn46~h%H6<;fS75<7qMX(}N5w3_-L@Qzy@d~~oNs*#RQ)DQz6gdik zLZ}ca3KhkQQboB!qNr5J6jh2EMV&&SXi%sWP|>LPMxj;c72hf*D85sCuP`WnR7_P& zQ~az_%u>u%%vUT@ELE&fG%H#ZYZV(5n-$v>zbSSr_9+f3jwp^PPAbkQ&MPh{{!m<3 z{HeI3xUYDmc&d1zc%^u&_)rh(8TIUXZoNglRek6BuJt|Yd)N1?x2t!ocdmD<_pJA> zA6!4QenkD(^?vn%^&$1)^-=Y)^$GP!^{Mr$jQZ?)L4AIGVSPz`d3{B_tiGzgwq8-+ zP_L?o^^Nu4)a&ZMt)EywseW3+FAdENzc#FHSlh6^VPnJQhOG_T8-8op)v%{wU&Dch zLk&k7es4J5aI)ca!`X)O4Hp|OH~i6Xt>H$)pAEMg?l#?S7mo)Pi1dqU!|?mPU)z0R=O!YmEOw1%Av~P z%27&RWq>kR8K#U>#wg>Id}XpSO_{08QRXQ{$|7Z{vRqlAlqsu~bxMU&sf5b0N{v#l z9IyON`MvT75#=%E zN#z;kdF3VLAIj^>o66hDyUGX3N6IJ4XUZ4Km&(`5cghbcOvR!8L@%wmYkaB5W8;fL z{z5Mbd4pbX@d2XxRLFoVNJ1_&hdgKnt)UI<3cJIeus7_hg0|2OI=}(Y8M;Du=m`fx zA2=9(1&6^Aa1}a2%WfCqV<80;j1Wz_UZv@7qz?E zQ|+xDto}+pOg%z9N9Wh>S%SWI$oWqPEn_;v(&k2p}Ig_tS(ba)KYbo zN?of~sFiA{9;?=>$Ehc%C#enUDe7tJ8S2^UCiMdKV)ZihFX~n5)#`QXjp{Ax?dqNC zJ?j1HL+YdINn_AV(M;3K(9G5}X%=V}YnEw#(X7&})~wTP)NIjg z*X-2n(d^e8(j3(s*PPOv)m+eA)?C%x(A?78)jZHV);!bvrFpH=ywiNt;##Jb)S78| z+D=*!NkndTD*ML$t%RBekQo{@NgIs5U|yt&P+2waMBvZKgIy zo2M0Ni?pR$v9?kx*VbsqXdASYwo$9m>b2vw-)Sdnf7Je@{aHIpJ6AhjyGXlKyF%Nn zZPBjPsy1jhYqx2C)9%*p(;n0w(H_&D)Sl6v*Iv^8p}nsCQ+r2yU;9Y=RQp2vO8Zv( zK?igU9b3oMS?H{EopoJxJ#@WveRTbF{dM*_N1c<-MdzmT(0S>+b%S(6bVGH+bt83O z>wIst;i_}HyVs-I4zAj0ZqSB@5GIUwG9GyTX)QNP3x?)|au3RV4RqABA zDqW4PPN&c{=u|qWYt((C)9UoPZ*>!N-|4>B8FWADrs}5Ye%8&@&DPD;&C@N=Ez&K~ zEz_;gt<ePboX=*bdPjTbkB4zbT4(Ub#Ha=bszOWPw1I?ww|Lm(_82*^_}#c z^tprtdcHnMrBBhP=`-|M`W(GLFVu_lh5BNBslHq<(O2qa`YL^mzD}>uH|SM* zsBhGNqu1*7`fv3U^xx^f*BkUd>Zj_b>3`PG)X&z>)z8x}&@a+2(J#}l(67|5(zoc> z=-25t=r`%N=(p*2=y&RO>-XyS>ksM=>yPS>=}+h*PwCI-&*?AdFX^x7uj;SsZ|WcF sAL*ay-{{}!-;ZOB>oTtAIQMZw#wCo)#f(2VZu-l+Vfx$lJudJ60BZ1oY5)KL delta 24684 zcmeIacYG5^@Hl#Vr*e|zLhoSQyRm`Laqr!7@3Ji$+p=WKauYIlhh+&uNkD|qL+=EK z-g^lFLJz(7-UEaHZ%(p}N%-dbd!P5m`{O>eRDJPuF9lkjXj2QS7;@OpeKJ`?{5{~2G6Z^8HBhw!8L3H&U6 z5xBm{&7VM(+ls7^#@!iKOV>;rejHxZ&JrZZbEUo5PiGi@3$ya;}nF!Bulday48nw}GqU zPT)@De#f28oxz>M{fWDjyPDg`{e`=UyP3O%yO;YL_b~S)_Z0U6_agT;_YU^~_cix# z?gt)^XU?Ma6_2Bj7+4CHD?iA01*Pr(d&zI-N3*tra;(20T8ZVuf%gf`H^5i@v zubMZCNAYw#J#P|kGH)txCT~7(0dFC11#cy96>lSN6K^|jAMXh7DDO1y4DS!#Ro)%m zUEV$3eclt^Q{F4yYu;bH_k4^m;0yWf`0e>!_+9zE_|AM6{x|#qd}=5^f*;9`;>YvF z`~-d?KZ&2r&){eBbNPAv5&R;)oUh=k_?3J$e#Y4tRQR1T5=Rgky^5W{FWR?eornYmyk=z)#M&>FS(E0 zPaYr-lE0FN$lu7rz0g_cBJ>b?3i}HC2?q)X35N-X3;l%w!cbwDFiIFLj2DW9$-)$2rZ7vG zE6fuX3P%WK!ct+muu@nhR0~H5DPg@(D;y&nE1V#lC^QJC2&W0B3ug=G2&-WC z3(z^kb*<9M{F(W4^B3kXaeMPu=C95FG}Lp|hELqBgu!B}A&mc`v!1~l7+lK`3YrTa z3?XNTG6vTf#N-0bl+{)_25WkkJx$U>=>R&AUd*5(29+?VltBsxsTfqnppgt}V36K$ zRnQ}NKZ6c3=n#VrGw3LT9x>|G+#3moj((gO6bFVg{EnxSYX(R3(F} z7`%$Xs~NnO!PN||VenB5PScL3v9{P$>_==GHXWOR&BSII-UyxB%)x%b=3?`(`Ovxm zTZk<(xSDmdT#2p4)?n+g4cJC(6SmoqZg!Jej4i{qV#@(;5q!5D+X0`uu-)m=;$Wqu zR4Oh~OKFTj6oY6Qqn+Cz>?Gz2(0j2d^RPx*L_3~^zve+Ni(#Zi(98Eois4wBrS12dA+!*dNfzS?FdtbaW0ok6pkn zVwbQ+>}UAD3A=8%FKQreV|NVY=AF5>vAftk!$k8=jt^k?htNke0gtf9*c0q2whDU= zc#YU~zV~?b9;hekg{%!@Eo0i*A$$1V z0oomr6LLl_sJr2zWwfO`@<5*OZ6D-?yis36s8tVsfB5?wG+?dFO4DZGAT&5LS{zlW zlH|&yffAKu0UCscV9qcs``1a#9&RbWdD8jF$6#&K!QKz~CpUdR zANl>0z91ugA%-*?`&RUYqlhN@CfhhtF(@|M$}(DDuoj^Nl*CF0b53OmlB<-8Cdd?&n$cAnG1}PmDt)1eb*$bCP{&ua#0@2M^aQk+tVJjC+$tUw;%VsKbYHqF z-7ifh$(72C%s+!Z_d_ANsh>VrKp#^-Cf;aKLt?bpUs1CVX-zyi>B24`q(@`tp)vFT zdLXz8R<3Di{Ct)b#`T3Jvd!NaR@+$<1~kQR($1s30dqc$rlKFwG(ew@W}um9mZ819 zd-pk*4LzLZfa>^_mC1_oB&?K9V%7jQ-;inVMl3-~4dd;*P)pD<%ozj_U6c!AkxTPb z3S~=|SbI~KG*0`_ezbo}18Qt)2r@NXwQ7gfqYY>y+JrWvEodv+hPI;}XeZi*cEgx^ z&|b6;?MDaDL2MJq>Nj*49YIIY?;T-@9mh6fo6#wB8f^L*^alW(TRYfc6)OJ15TUE+ zn#mA>(TSkvvZlwxms{AB#ppJ=gYKex=stQtN7B)>n9iUjw3K!{-(*U@FeK;+dWu~_ zhhg-?Fy1ReoRjO-6i#EC@X>~Fw;dr`Y{~)vq48R}ke)(Mqa82f-{RwN89pBR z24{;;z!u>XLDb8j&+qW>@kwwQ@G0m4J{8*yD)<1Oj%_l;xEBwY1uhhyL>JMH7qPbZ zT(k+FhtFq~1UGrWt@uKG5xy8-0;8+oS^;Wu1Yc!%=APK85&s2WgRjNc0p@yq1MUf< zY{EAiGCUI6ZN<0Y+wmRHvJ)_O<9qPEhP@vC)PDG88-4(XRS5zYtCU6ZLRwCjv2M97 z{u_Q6KLYmJqr%jnh&8Fl@AxsJQ)u!^CbR|k@Az@dxuqKu=t=w(*dW#qh{3Q(3Z)D2 z)A$+u56qeU+MxCHb2`V)c?n%YJDN}~;g^lQM@niHm8vL-9I%x0@hgVMo?Sa%!>_ma zBi4;bisWqL4MVR!9sAzGZ{v6HyZAl)K2ZMve~A5!Kf)j5Pq6j)Q{dDp{002>5;*W0 zuBqf2*MAdKZGBGzOf>+ zf$+y5bdDHI3^C;UIJdDOhR-K#SdRq$iSQ--40C+C5dN4m{On{n;nTTO5D}bal6X>) zw0aQ{LWHtTZnCduE7BsH80G70TVxypTM0wN(_`t$$s@hotlhopOd})`Nzhw>tf-9b zZ6T3pa+sHi6ywT$NTd>Jrj-kXren*A3?dWvB(mTr;{kgSdGKFKWP;2`84ml73ojvL z(4jaF;t!crxriufHg1=Q6jRXH+#z(`)FGk3RuR(X?w~{Hj;Jxr^-FZnfKMjs=vnl@ zKM0y&h|xesJ)s2-HvpU-BI}jeR`!M*|Mmt?|3k#L#5luy|8B&1VuGPdz<^HQ5#NJ4 zn5Z#L@H=*bhQfeE;zwedVP`-G_a9sNcw$DA-(6zzyAbLVKM`|@dBl8T0kM!+WI%!4 zb9T|o=%oxAkrD;VBT6c-H2O(mDK=#hv5Z(wtRPkrtLWwQQTjfE;uw?;=7wk_ej(OC zcWa4tF!S}$X$rA{*htJEHWOQjtw>62hifOXi`Z?b3#82U0qlO_0CAA`)xZz(b2>sC z&9<@vSyfi36s7Uf3Pq(7B2nT9=6s6y41B^+7UV`X)BFc?c#hshucKGcM@&>+z@{uG zE)tiB%fuDpDshdtPTU}F61V8}^d@>Uy_Mcg@1gh82kArfZ^oSl(A{XHdM?nr1!&x8 zr1l}Po8CyTrB~AK^ai>y(JvRQiAkxR4k4a_60n>JQ%Otb6HhVc3oQ(IVeITBFo2!@ zc6R#M&%{~rOK+JJZVKM>2lg|%sB0UQ#$}=r;$^f4%n2rv?G|qY*3*l6n0LOah9AeoURa( zvtP{TboswAL6#r^P?RH}bLhr%Eqq}WqZLnxtsEzga|`|Z=)H7fLTFLGG>#haRV0ol zt4Dy;mqlueb;dB`%=gg;=*Dyw(>g{qLaMCzDt5CLa)z`F=}!O3GHZmQ+S*Sh`z%1} zf05w-`2-_y*Ot)^)5&yWTzLjCn+>U@EMvbeXzGh)!%2iI*(m8HO_DxFAESR~C7lpl zB$J*3uKt9z0sW|1jsL*lK+TeKmUE7C zo^ye7k#mW2nRA76m2-`AopXb8lXHu6n|@3`qhHW3=|Aar^xyO+I9);v;xLHIpsoyZ zV~`Jn!oH^L8##xYX84fv2xj=usOwMZC$PE_<@t&@_1Cy^xXBnjtxObV3Bq$=rG2Wgs)7uUOa5C#zp!s*5| zF<|AXSkoORVLAS9hExB^@qcQpQDKcl8p9QCAY8#lg*E8}5X(2-ye88t&u`LMZZJ2J zn9m>{gUBYW<;K9F0>zEx#&P4hVr~LAkwF3mi5O(Tpf(I@&!A3lw$R!+a#Kw1ksH`F z=?rW=H6XFUm$LKvCVOa_@TNXXh@)@sPHd{}!0|3f#N?naNv&EOVr3yIyId$0mB z%nf5>oLh_}_~w5NFUMYU!TPtLSux0xZcGg>lIL4T!=56p@P8P$iTrBh%&lpK-;ROf z+Qv*HeymbjRivmKP!SjM-<{B0hC8}dCmpRo1|19|Vtciw{U40`mOHK$N*4xoX0@_S zcx7pswMt=aQXDwXiYxx#bYKd13U}(4I?$a#aCf75;Kj17+8gG^wWpf(U?z7Ks|P(8 z)RW$oA})jDOxO?`y%={cCf$$caHNUo}tMDNXEL z$z8=xs=G-GdNatH9lr}3z8HRr>+%(LG-IykZfJ#R#~@o4vu(f#Xa zFCd)_3;svQb6-HZ8Xm>lvv%fRVF+t&ObhuM_Zs)cmqPSl5ZvzULe3Od=2obRRF&)r zXGOClZ*cFil7uzy*}S43LO8{J#C^d&A73>w6s zAq*P!l~{#)t%)mtnP%W&;)<8ysJKh|SIif{|AXxwtn9yJduy&Y_0Kc=qW^vdzl1Jd zTH-Es}nmX8-s1$FkS$wAHEFoZ_*E5Fr4G@LU^IPFa`xMD2PEJU(o{IkS12d znke%#X+fZ&XVO3XWea4=7m&g1;VGYGtV z%2&-eZ@kHj^M2yZWsR}eWX6*jl*G!@$|%nv>^Y~ke^DVESjM@2B_3+&Whrl2t6tI= zlxiqV>H38a`05!9Zw*}Qj1p~`XeNW;&M-=_I1R?C=dq*`EbO6!-`oGhC`T;x4Mv)~wQJ%fsA|4a#cKE!V7*(0IPi7rT>^IjO? zApDcj{%QG21?>J+kiKgTbb|NR2-KEAa>LHF?o`V-ybrvOY!idZ7*s*~pNAxhDK*Vz z#vehZ{V^Z0NepZgpNm0Sn$O36W{{Gk9cZi#_+Ci0mkUxydU<{0X6@at?mYIDgf;I& zb8-U`)>3|321jLvjC8k-Eo5NF`JIduLi}23n3LY?Gll%_{2nF>s~M!G{n=E@m&tRM zMr$LDYp^wZdn1*OES0q^l|owB?i2i@F(hKCtr4V+^cpzO%^E)HE;N(NcQt0%KVcsc z#&_d)w_>wpko?{A3A=!U8dBQhLYkv51w*hHF!L0a1Xs+E;7&$tOPj2j`- zxZRjxguKS*3?qLSFw%$b%lCuAhM(EgB0rc-E%HOz)FPK*P#sI;Xa?0YXcR3J(5|#A zgBW^I+deg*)gd%yu*h^aiw2{>?~cu6fF}RUqR%uD*Z65hPQuF3(f%1D;NOHeb0{3zSS6E@_aT;+$#GE zN6mNmql^gA44Q1Xn`QHP7<>|6YiufFAQ#;$yX)sB)X4wV*aR+gsv#!3b1UB6;(u>! z`i();fOqAUMPFNU{2%yJSuh68V9-8R>}~&%USxCS@YnL!@xhM##Gv^M+RC8qYzfO(lBN7j{LQ8;FVHxf56L)o z70qMNT#`Dh0hxPasF)V2oQCO&2aKhQ~Wcqkj^q_A%h?STS&v?V2Z%9*|t8%p}qqCF=zpU z*0NmLWZWe2&qEBwKf*u5KW@ZZ3n>3&H{1F$U?hxF2g;Vw6=(1-a;qdpB785~ zA8hrP)5=r0F~v%9*c2;+RT79C(h}y-lEx%E zuxU)P6WjA@8YAgCdK?X|nN!r8_GHk{G}e?dB)gK3GW=Rjvl+mKbZE*clJ;y)5kl_9 z=B#37o=?z!rrXFq*eZ}3TtpuHZ%Vh(QyH|5G|CLb#@>eOdA0#5|5KKY9Li?dntOqM zj7dATmklKS;}`ve(?AOF5$0lT|7dTvL?iyHq4SHbZRl* z{5511GFnAgiU$n*f*!5f){`1j+ja*1Y8X<`yH(pdaiUONfZP&;#rZ!OL zBZid)T~b=cBPWm(O>Mt3=pk!`Ey+pbWYU1kuzBPZ(Ayv2^m_r6CoCeTl0Rb0$!XXs zat1k*oQ3^N&LO9fbIEz+JnRU$fLsWv_8x`#)NN3RI}EzTpqsFqA28@PgN`xigz*NW zagxR|#R-8>DUdA9WyAL5rk}8X0137#DI}MZE6A1PN>fQ8gA)vnGdKo!lYt-`G56J0 zR^%__8gebUj$BV}AbV{jH<6pkE#y{m8@Zj_LGC1XG3XS7z)7EB&>x0&Bka}&j5voV zsBs}7ULenr=hMRS;ee&6ph&7rN|MMbr4{V@zR#e$&8z1kd5OF{cP@kO8B=fMRq|T4 zRlAm|w$JJQ1>{vW;ctSvLEg-Q*}+*_fmA7#L&9%9c?*iM*zc&%Uz&jLkawX`@30x!>al~h*bM}*VSFd z|HFp~u+POyXS4UTQUQftf&L($|*^`t$R| zzgWHkOMw-;eA#J}Ez9>cgI*bzZ_})^eb~j@cL1!|e*gR86`1{V@xC-9$s8kER+7M0 zU}vK2Erb4I_W*6NuNWkO6Kjx+lo<^YgWj>$h^5K!tL&T4VU)m2;BD&fZw5E}KaP(C z{Y~)^`ARTYFocbd1jE_*NZ{8xJo?ZQ9z9`j0fVyLrJ{m@s_Mt)`>;XMn z2@^A8^$gY>f~mcv9l=Oo|0*>G9a@4dW$T}?704Ob|Fa+#48t$vD-6~ze6ANH3X(vt zHj^+Q2aEyT-!yLq=fYkFC~`G=N+*Y$udyBg9e=t>IK#1B@iqTw$ z$-mazviKh@0Vy*!Hh7*5;me33jqQNf_J~dNTAbZ`qJ= zB*4%8f{l<>2d3LYYZ|*rW3%!VgPYJf`GVg7;u3>9LVG3{-U5ZP)R;OR+%k2J6goN% zU{~3WoB=SsLQ*A7P_SLK^i(J~10XjUoPq__J4;z9kA>PcQ=MB2&f8GkfxF7MxUYD64wFj z5rFMy!TJK2Axzn=OOvpO8_@a!S`V_V{n^$!Wj9bXRxUdQZ&+?-Gxz{#$Y|mRdjRyg zf2hQrA@~3th*@?F0=VQnqs{&d!e3(oVK*yHFfH69E@JJ4B%rTn#~%vl*;YLihE5ed zTa^7_GxpWi5i`g$O&dGYMdDKNhHxb*g!A z7@Mq6<~NIj`%>701%gL10Is)TU4@;A51g|?8yEvjUl4qs2=#!97MysYBZ~u%eS|<8 zyOlR74VyZPmB^(sQ_*}gJm-?o4Z3>A;9&rsRL16Po7=dFLNB&2cwi*L*jJA{L$a#p zAd@Uq!f)8dC^;@W)R+S0=#;Sd(64}-@5km0h*ro9oHyHM!MHaIYN9NW;Y z(za`p0`Q=eTo}wYrm#E|v(2%U9hzo-Sr`H2g6Bzu@4YPwwVxKr7(wug!zL(@0|$+YGwaq6X%>z3bT5~;Mo9@ zsDv_rW^~RKVKFp)VsJ1a{d*_pe@S$lN!sw74=e2^tHFILtYC+P#gh-;8ah`yq?))c zHi5&VK&`wRgO{)kAF3VwOvBC-j$<2oF?gwQ0LuzUJcd9lTVd45&kK{d42+!w^WDtyRl)Wm zukP3+`isJ;(DEmPm&5moc~FtiOcF0tIFlU!Rzn4}Wy#pw#=ln6eBoRc$cDiyS)e>N zg$a@{rdgYN;>Mad1d+gJ4oTW_E(n*w*e@Bp22d07DnIL4f(fC0YlOC(tHL$xSct(# z0zz7avD^Tv4O+%|A>7CUzynux0ANV3ZDJxXOt_70fYB+oVNz{-mmh_@gzSS1_k??e z`-JILtp(Dl2PwuwuUO5F7kM z*djcF#;&%~A@-S#Mkp<3A76L_HT-SRJ$x9tk0(P>xC#omp{g7zFqc6YVpB;ZN6@+` zl2{JKWo(I94X2@1nHV*KSOMiaUoE+Ts)$xq4V)X0A)og-tIfFy$<}`)NjbM5qh?Hu zac)CG3GzY2N=Uds!h~1_>4>H@0-V{+hLf;Ouz^4F4IGxh84!CYMy3nAAfkN;8;+H* z8=SyKi~>vkAUH?v4rj_U;bE-f*a_?j?*kthJV*AYT9T0%Hcj z7DGb|;WQae&EerU5p6-Yr6G_lgR_2mpiwEz5{*iMQSC9fjCyex^x`nM)5GA^4#Oi1 zhgrQ~E0MAGO?tsrBpUUCEkA6!0E1PFuU*%TzQ(8*ji49pc^?cv*Y%~gLeb{uYYCJtvqhAwX0Sh-uO&3A8DF`Kg=C-? zU)=P=X0-s#_Cy8DPAz4|KGJMUp~OxvE=`SCzz?c|JzS6o2;SeSEEi7)}r4;hebz3 zM@7Gjj){(oPKZv5PKi#7&WQdHofVxEoflmYT@+msT^3ytT@_suT^HRD-4xvt-4@*u z-4)&YMs#2FK=e@bNc33rMD$ejO!QpzLiAGfO7vRvr|6C7t>~TTFVTC^-=YtqkD^cJ zm^m`X&55-m>r;>e{Vju!VeqjG4!?|J@bL^jfx#y-_;(EcJ%dkT@W~8rSew`|5ntP7 z%r0a)&$pOltjsssbc-oy>|A!0!t*i~KUz$KL%cBmnA~D0d|_)~=3Bty9k98L7Dq^H zrTKo!yb(oJQsqgDnHICK^%k=Y{l6Vb+4EibDg11HDZJ=lJbwm%1OE{JCjS%3BioSe z$PQ#@vK!eGUSnWOI*`urDg#e)AQ=d+F$g7-$ZWD0-dQl3)WdrUrjrZFMeweIMmYN1 z2X7}hC724Y3Ya071uqMj3$F`U46h4V39k!SBUleF4A?5z0WS>LCpc(0{q1aOErdPC zgy)3Ug*Sz_g?EMb&791<&3w)B&17b3Go9Hqvw3D~&32g`F*|E^+w7^?bF&v_FU?+? zy)k=d_TKD+*(VVa5hAXLFA|7sL>{6(qQ0VUL<2>GMZ-kFqA*c}C`wc;l8NM^GLcfG z5><<8MWaP}(OA(q(FD;3O0)|^eih{P4rKKaq$DsmGZ&d#m|K~*Gj}oXZ$8{S!93GE z-@MFxy7^r5-RAerU&5pRZ_MAC|7HHS`9}-P0=FP6x?1>HL|CL+SHy?%CGmT-m80W>V2U1(cY(fU+(>&_tV~g+i-2nZQ9y6+Bn;|+PK?z+JxI=+mza9 zY)0A8He+pO+AOsB#by&_v)ksV%{iMJHVI*2_Nnc2JDweBC$tmUS=e>4 z^RV->>u)!}Zjhb7U8r50U7B5{UACRXF4wNauFS61PGdL9j<%a>NBv}X*zUO9b-M?4 zZ|yOA+@534vnTD_*tfIqU~g;hX76F&$3Db9);`s~%)Z)QXaA%9bo-h1v+aMfZ?s=y zzs`Px{U!&#LwkpQ4*m|24yg`#4z&)G9hNz4a5&}g%u(Rj&C%YmucMEn*fG&D*)i2I z-7(WK+fm|}=a}zU;5dSEEOwMR${i~lD;=vHYaM@Zoa4CEagF0)$D@wN98Wl&ay;XB z#qpuzW5=hC&mCVnzIJ@$_|B=PleLqLlf9FplarH+lbe&LQ;1WUlhR4$ROwXhRO>X- zsm^JX(^RLePP?4;IPG&f;Pk80A*aJmN1aYO-F3R}^w8-PI8twPjz15yxIAf^L6J}E82UbP02baEWq>afx$Db18HwbE$P1?J~h-gUcqDEiPMKw!7?f+3m8|WxvY-m&>je zuAN-FxOQ{3cC~S}b9Hcaa&@6xhqw-R^>y`k4RDpY%3aG`%Uvs6D_yHyYhBf@-@C4N z-Qv2c<+)Lc4Qg?-W zxqF3srF*q|t-IP?<37rrb|33L-hHC`_wL)>54xXszvcei{iXYB_c!kE+~2!@aR20i zJO~f2hn0u3M?a6D9>E@Q9(f)zk4lefk6MqB9^ZS+@L1%r$>V^>uO7d79P#+w$rE|vo@SmsJnbk?ch7G;13jZW(><#_$9w+ZIn8s1=Pb`fo*O;4 zdH(Ks*7LsSlRj9V{(b!VB=nK@ncQblpFMq!^*P(;u@}dyi&rjDNnR;lGB3uf-mAe&?={wIiPtu-9bUV<_IT~{I_E`Q z_j=;>(wp=adW*a*ysf;udOLc1c=z%4_U`9B#Cw>xkGG$9fOn*Kig&5E!n@qN!n@L& z@}A;7!+XB>2JcPYTf7f?AM!rzeboC89~&P#A1|NbKA}G0K9N2NKAAqbJ|#Y*ee^za zd>VZ=`|R^M=5xX4y3bo*b6-o}HoonAJ5atJzC(P6`TF>V_{RFC`{w&j_nq&%!gssx zG2aWmmwd1IUiH21d(-!}?-So=zAt=V`TptG#;>QJqo23mFh99pnV-_H!mrY=+OO7c zq+gvM<;VDa>o?zTyWau7Lw<+-j{4p4xA1rM5B0D0pY8vX|2+Q%{=57S`QPxrAAkpR z4xoAmcmxax@C!%_kOq_mXagn$%neu+upwYmz?Oh*0XqVY1zZfc8So(BQNWXcX8|t* z{)T;oRbbn|_JJJ(y99O*>=_slm>QT9s0thvI5yA_I5%)n;F7?Vfj3-Y3Zh6niu`3D6CB?lD*RR`4ujSQ*_ zqJqW*%?|o0XkO5QphZDTf|doX2wD}iI_Q_6wL!;&P6nM0`XlIE(1oB&K{tXP2K^cI zKG-hUJJ=`KFE}7LFgQ3kG&n3cA~-6zI9L`e4=xK<2CIUrf*XR@1g{I;5WFdPOYpYf z9l^VT_XJb>f{zAY3BDG5BluSEo#3az&w^isa6-&O+J|%r@ec_M2@VMf2@8n`i42Jj zi47?asR*eIsSc?P85vR+GCD*XvM6Lp$jXqPLmETYgscnM5V9xaX2|W3yCL^O9)>&) zc^dLIw0Ed&sC}qIs8gs*sB5TusAp(wXnbfwXi{iOXc`ro5tTpf?sPO6GGsE|V9|-?7{80Ge@T1|shaV3=8U8Z-b@-d`cj52D zKZJjZ=oryCVo=18h+z>v5q=Q?5kV305eX4>5mW>dQ6JF|p{F9oMvRM?5b<5al!$o| z3nCUpEQx50I1zCw;!MQZi1QH_BQ8f=jkq3hE8=d%gNVlw&mvw%{2B2!vP)#Q$R3fs zB6~;LM%qWZM7l*rMaD$NMT#R6Ba94>er~>qK-rzi#i!~I_hfF z^=Mu+87+(!MVm)kMq5R}%%Ud+Ro z$1%@hUc{Qkn#X#?dd2pQ?H@}Gj2#j?EH*Ay9IJ^P6-&pCj@8EMW511^5c^&1q}Zjg z>ti>?ZjId@dm#2$?4{VNu{UCG$KH#582cplSzMdA_HiBK;N=r>J>#t7hQZwd8se76t%_S6_e)i z@x9~i;vM3h;$7q2<0Iln#23ex#w+5><5lrh@ju4zir*8zFaALMuknZDe~&*Ae=7b= z{LT1h@h{{5jDIUe;F9N z6;BgS7ta*W63-FO6>k^s6z>sJ`@{#ths1})SH$nd9}=(xJb{zIPY@(@Oz4}?KVe|P z;Dn(GJ_&va(Fr99r3qyT$^=zHbwX`IL&E%og$YX%mL;r6_&K35VQ0dngewWx6K*El zPPmuwAmKxzL!winOQKt%N1|6^zr+EFgA#`%MkS^tW+vt&<|dXTDibRcYpBGLiFJuH z5@#j;lsGSOLE_@XrHNY-&nBKvyp(t)@mk`|#M_B)lG-PAOzM)W-C5=vMNYW>LpY%i0w4|9yvy-+YZA;pjv^!~U(t)I3 zlg=i+O8PVDUDErc56M_Eo@|voESd62_Dc>(4oVJ9j!2G9j!lkFPEO8GE=(>?mL*pv ztCQ=J>EzML3z8QnFHK&ayehddc}?>E2NPJWvFBKdXln-sGY^OV6ULsN#Q z_@?-$1f_(gM5IKe#H1vp6s8oV$Wjz3%9N2Q+7x}twls{A6rMyq&r1DZdQ@vCBrS?x9kUA)JaO%+1;i=iFxvBZ7 z1*s!aOHxZyN2g9oot^q~YGdk})b*(wQ}?I-k$NumLh9wztEmrC-=}^^{gj5Manib{ zxuErTvsPFKt2EqO`?nOVgI8txh|X zb|LLj+Lg5HX*bh8rdy`BNpGLtDZNX&e|k`QaC&HZczR@dVtR6VT6%hVLHc*;3(}XS zuSj2&zB;`zeNFn>^!4c*)3>D`PrsgiGyP8b{q%JUCd!~P;I5RObIWsLYBeN<~pE)*jT;{~g?=zQYZq3}DxifQ5=Dy79nJ+S5W&WA@ zF7tg>+br8G`z*&Smn^re@T~N#%&hFJ+^qa8N}V+>YeLp{S(CG-WG&6woV7J;d)BV3 zJz2-Hu4UcGx}9||>p^z^?19;XvxjE;Wcz0aWrt>mWk+O3XUAs8XD4PSXQyVXvZ?H8 z*)y_dXV1-^pS>`9RrZGL&Dq{r=;X1~pTpZzfh zIq^9OR8CS(YEF7iW=?j_{G3HOOLJD_tjcN3S(~#VXJ^iyoc%cmbAHP?m2)BIa?Z7! zn>n{7T_xQmy(Bggdx@jOMdBuLm-LbJmGqYkm-tBnCBc#kNu{JlGE!0}p(XVaon(w; zoMftGwPcfIt7L~{m*kA(tmJ~^vgE4dk>sg_dM`CIZ)@+p_hHOsZgwaN|34b2VD zjmVA4jmeG6P0CHlP0!8DEzVWsmgiRF*5s;lHMyg5$K_7Wosv5>cY5yJ-1)f+a~J0> z&0Uv!Aop@!+r0L9o$@;8b<69S*E`QH&mqq#&m}J?uPU!5Z)Bb(Z&V(Wr_IyneVaEv zZz7eqIB!SZ!Mxw{j^-W9yO;Mc?@8XXeDi$o{C@cZ@(1S+&G*Uo&kxEE$9)@^9wf&cB=gDF2PrO4?28AoY^^LvA!g z8ZM2LN~KlO8tF*sC@C$SE&W;AC|xVvAl)RT{*d04-j_a-K9xQ%;1zT#=u*(VpjScf zf}Dcl0;*tK!PJ7e1se+X6znfJP;jW=NWrm!;{~S*{wO$KaH-&G!Ht631$PTx7knt} zTG+j?SD{UzeW6pKOJU!_q{7s~jKb`~+(K#Lh{BRWd0}~>s<66HU07F07uFZ*3da;K zEZk2OULHY=upSXLqGUwfi0LC1jyN>pagm^?eUWofKv8;8Mp03bs%T_UT@hVWU-W&^ zq@u}1KNQU=T358SXkXE(qH{%ei=GvID&`c6ihC6IDz+)MFLo@BEfyCi6(<*`7N-|y z6-$cqit~%>imBq!#SO*!;<3eZi_a8aDZW;GqnNr?e7E?1@x$WBB}7U4l8z-^O1hWy zED0$IFNrFNE{QD>mn4;>l%$rFmrO00UNW;}cF9jAb4%uzEG*eka;)S;$?1}_CFe^% z$}kxr{lKY`JWuY_)8SY`tugY_n{uY=>-@Y>#Ze z>>wpOB)cVhDtlXsN;#$cQemlisby(&X-sKsskk($G^I4XG^9?ixN;jAOQF^ZQV(I15tEJaVUzENo{Zo$QUFG)jzH&c#ygWgkEKieX z$P48)@{#g7IVET0ljT3if0R#`&y=r}Q>*2_$k)o(%MZv8$q&nammim3ls}R`l|Pri zlK-g?D7q?oD0(Su6m|+Pg})+55uylJL@II=QsAsrXhgQ!z&|SFu2`NU=?E zRB=pkLUBrQMsY`RU-3}!Sn*Wxx8hS7UdAo!RAyZ^u*|0{x-7jct4vasU#6zY#+6Md z`>t$q*$-uN%T|@GE?ZN!zHD#V>9Rk{&Xrv(yHfU`>`mFbvcJndm0Of|EALTmU2a?M zQa+@7Sh-KRe|b=OM0rMeR(Vc&UU@-zdHLvaZMm*|Z29=|MdcgHH*FM=CB>+^cw4@ucFps*S3rs<+CHQaP$Z zRjH~BRhCMk%2!pZv?`rytZKY!u4Q-()QdU(~&8S*ZwY+LoRb$njs#8^G zs?JtjsJdMByy{~$R!vm%szudZs=HVBsTzj?ldhN~H+qHLV@7F%8eO&vr z_Id5g+Sj#jYTwnqul-Q_NsZKmnyaSxYJu8JZLYRbw^MgicTsm&_fp%a?bS|dSG9-Q zOWjXBKs{JJOzo=k&`$Ehc(C#k2Xe^k#<&sNV>FHkR5FH^5nuU4;7uUBtUZ&mM5@21rI)CbkSsgJ6U zt52!_P@h*{QeRbHSKm_KRo_=XR6kZfRXRqd^CQV08Nl4L=&co&_rosG;tcSCQ*~D zN!6rlGBw#6iH6G4NHv9;B29^=RHM+8YbrFAnrcn0W~8Q0LunXIy+)@Qs~NBPPBU5a zgJzm$hGw>Au4aK|v1XZOrDnC}7tK1&M$Hz@cFiu$Ud;i`AQo$I>Q^{ne%XIJM? z=UnGj=UL}n*S~IH-H^KBb$)dLb-{I^brE$@buo2ub>h0jy5zdFx{Nw0^$j(U8cYqP zhEu+jKNUy?Q=wEi6-h-?u~a;jKqXNrR2r2*Wl=d)E|pIeP$Q^fN=C`4GD=BNDyoXA zq12Ry8b#66Xi7`zs4>*H)Oczl^*uG2nnF#brcpDfS=1bAE;XN8NG+k3Q>&;(YAv;a z+DvVuc2aw&{nW42Vd{741a+D^OI@HYQ`e}Q)E(+R^@w^(y`WxGZ>jgxM;g%_nh&Wy zbJ~h-M|Y&VP;_^?7i|MI;ZE?JiU;jQ_k;ID4yK3EzVL?HU^)z5dKg2;!$Tw~bUM6# zPeSLz+vtkvQh4B?0^Va*Lyx3K!K=bX(^`1T*BE$CU?TlJJsI9tHx=GkHdf}TTXqi9)bGYb{8{<}ygB8X@y#>$;T0cG;iVm~>9_QI z`Xf9-#bNl2kTGYhn08D@rVG=Z>BZPE_KXwb%6KqdOh0A-Gng61_%Z=ZFcZc^GBHd% zlgOkn=}Z1Z>%Xm^Q2%|sp?+%p^!i!#Kh@8#UsS)eentJy^}p1wtKV3^rG9(;uKK<8 z2kH;iAE`f9f3p5e{ki&!^;hbz*WaqYTmPW`as9LUm-T|+?S1Vd?NjXw?Q88@?R)LV z2Gqc5;5P^x%p0s4+BI}+=+e-=p;v=VgMEWjgKL9FgI7bph5-$O8-_LbHUu;TH-t4r zHpDc<8;Tdsq=x8*>3np4x&U2}E<_imi_k^sVsvpju`W@UtV`9U>oRrOI*Be%C)E|| zigYEqQk_CquB*^h>Z*0Mx{?xF6n?y2s%?xpUv?v3u9?!E4V?vozr2|ZWO z*9-J!dUL&{zKy<}zJtD#zKgz_zK6b-zPH|1Z?AXMJL_Hb?s`wXm%gvQzkYz88l)eh zAEx)w`{@JpLHZDVm_9-urH|3a>Bag)eX>4PpRUi;XX_>UJiSz3s4vo&=u7nqeYw6u zU#YLw*Xl>=>-3bK(bwx6^m_eR{W$#u{df9FdV~H4{g3+T`kDIK`k(ak^b7Qh^h@;1 z^egnM^sDv1=-2Ak>o;ojoAq1u+x0v3yY+kZ`}GI)hxCW_NA<__C-kTEXY^DTNjPn?eF}`EM Z#uSWEK> 86400) { - $curr_version = file_get_contents("http://git.profiteroles.org/profiteroles/Minat/raw/branch/master/version.txt"); - addline("Version check, me=".$version." latest=".$curr_version); - if ($curr_version > $version) { - if(askMulti("A new version of Minat is available", array("Skip","Download")) == 1) { - exec("open http://git.profiteroles.org/profiteroles/Minat"); - quitme(); - } - } - touch($checkfile); - } - } - if ($p['mode'] != 1) { $p['premature'] = 1; addline("MODE ".$p['mode']." NOT YET IMPLEMENTED."); } -// If SHIFT key is held down, open debug window - -if(exec(__DIR__."/bin/keys") == 512) { - exec("open -n Console.app --args ".$p['logfile']); - } - // Make work dir if (!is_dir($p['workdir'])) { @@ -99,12 +68,39 @@ if(count($argv) == 0) { die; } +// Preferences + if ($argv[0] == "Preferences...") { exec($p['phpbin']." ".__DIR__."/MinatPrefs.php"); addline("Launch preferences"); die; } +// Version check + +if ($argv[0] == "Check for Updates...") { + + $curr_version = file_get_contents("http://git.profiteroles.org/profiteroles/Minat/raw/branch/master/version.txt"); + addline("Version check, me=".$version." latest=".$curr_version); + if ($curr_version > $version) { + if(askMulti("Minat ".$curr_version." is available (you have ".$version.")", array("Cancel","Download")) == 1) { + exec("open http://git.profiteroles.org/profiteroles/Minat"); + die; + } + } else { + alert($version." is the latest version","Up-to-date"); + die; + } + + } + +// Console + +if ($argv[0] == "Show Debug Console") { + exec("open -n Console.app --args ".$p['logfile']); + die; + } + $stamp = md5(serialize($argv))."_".time(); $workdir = $p['workdir'].$stamp."/"; $batchfile = $workdir.$stamp.".sh"; @@ -182,6 +178,9 @@ foreach ($argv as $target) { $mimecmd = $p['metaflacbin']." --list --block-type=PICTURE ".escapeshellarg($files[0])." | head -10 | grep MIME | sed 's:.*/::'"; addline($mimecmd); $mime = exec($mimecmd); + if ($mime == " MIME type:") { + $mime = "pic"; + } if (@$mime) { @@ -248,7 +247,7 @@ foreach ($argv as $target) { $dest = $destdir.basename($file,".flac").".mp3"; $lockfile = $workdir.md5($target).".".basename($file,".flac").".lock"; $cmd_flac = $p['flacbin']." -dcs -- ".escapeshellarg($file); - $cmd_lame = $p['lamebin']." -S ".$p['lameopts']." ".$tags." ".$covertags." - ".escapeshellarg($dest); + $cmd_lame = $p['lamebin']." -S ".$p['lameopts']." --id3v2-utf16 ".$tags." ".$covertags." - ".escapeshellarg($dest); $cmd_lock = "touch ".escapeshellarg($lockfile); $line[] = $cmd_flac." | ".$cmd_lame." ; ".$cmd_lock; diff --git a/Parallel/.DS_Store b/Parallel/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..32de6117e7f46e704d00f8b00a5fe7b735724278 GIT binary patch literal 6148 zcmeHKOG*Pl5PhXt1ay(5xUq5JQp^p8FfOyo1=Ngaz?dw|+Bt_8@(5nXS05#VLl6W( zse-Oo-CfmF{b0Jg0LWz1jDZn=A)BJ8(IYzCJGB?i1ESa(Q{3Va8=O=B4bj{WF~v0& z%y~Qi1#TYh#Deyd<*Kfm&C?usdpUVNe%Kr-;p7?43dt0&x4+^t`>r*~~(yJAyOzg7(j?am{B9X&^mY|`h8+VraeTSr|* S$1R+g4*?@2RWk4k47>wxN-=N% literal 0 HcmV?d00001 diff --git a/Parallel/Parallel.php b/Parallel/Parallel.php index 103363e..69d2763 100755 --- a/Parallel/Parallel.php +++ b/Parallel/Parallel.php @@ -9,6 +9,10 @@ if ($argv[3]) { $log = $argv[3]; } else { $log = "/dev/null"; } echo "Starting ".$lines." threads..."; +$locale="en_US.UTF-8"; +setlocale(LC_ALL, $locale); +putenv("LC_ALL=".$locale); + exec(__DIR__."/parallel < ".escapeshellarg($argv[1])." >> ".$log." 2>&1 &"); echo "\nPROGRESS:0\n"; diff --git a/Parallel/parallel b/Parallel/parallel index 2f96b4b..808aac3 100755 --- a/Parallel/parallel +++ b/Parallel/parallel @@ -1,7 +1,6 @@ #!/opt/local/bin/perl -# Copyright (C) 2007,2008,2009,2010,2011,2012,2013,2014,2015,2016, -# 2017,2018 Ole Tange and Free Software Foundation, Inc. +# Copyright (C) 2007-2019 Ole Tange and Free Software Foundation, Inc. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -34,113 +33,8 @@ use Getopt::Long; use strict; use File::Basename; -save_stdin_stdout_stderr(); -save_original_signal_handler(); -parse_options(); -::debug("init", "Open file descriptors: ", join(" ",keys %Global::fd), "\n"); -my $number_of_args; -if($Global::max_number_of_args) { - $number_of_args = $Global::max_number_of_args; -} elsif ($opt::X or $opt::m or $opt::xargs) { - $number_of_args = undef; -} else { - $number_of_args = 1; -} - -my @command = @ARGV; -my @input_source_fh; -if($opt::pipepart) { - if($opt::tee) { - @input_source_fh = map { open_or_exit($_) } @opt::a; - # Remove the first: It will be the file piped. - shift @input_source_fh; - if(not @input_source_fh and not $opt::pipe) { - @input_source_fh = (*STDIN); - } - } else { - # -a is used for data - not for command line args - @input_source_fh = map { open_or_exit($_) } "/dev/null"; - } -} else { - @input_source_fh = map { open_or_exit($_) } @opt::a; - if(not @input_source_fh and not $opt::pipe) { - @input_source_fh = (*STDIN); - } -} -if($opt::sqlmaster) { - # Create SQL table to hold joblog + output - $Global::sql->create_table($#input_source_fh+1); - if($opt::sqlworker) { - # Start a real --sqlworker in the background later - $Global::start_sqlworker = 1; - $opt::sqlworker = undef; - } -} - -if($opt::skip_first_line) { - # Skip the first line for the first file handle - my $fh = $input_source_fh[0]; - <$fh>; -} - -set_input_source_header(); - -if($opt::filter_hosts and (@opt::sshlogin or @opt::sshloginfile)) { - # Parallel check all hosts are up. Remove hosts that are down - filter_hosts(); -} - -if($opt::nonall or $opt::onall) { - onall(\@input_source_fh,@command); - wait_and_exit(min(undef_as_zero($Global::exitstatus),254)); -} - -$Global::JobQueue = JobQueue->new( - \@command,\@input_source_fh,$Global::ContextReplace, - $number_of_args,\@Global::transfer_files,\@Global::ret_files); - -if($opt::pipepart) { - pipepart_setup(); -} elsif($opt::pipe and $opt::tee) { - pipe_tee_setup(); -} - -if($opt::eta or $opt::bar or $opt::shuf or $Global::halt_pct) { - # Count the number of jobs or shuffle all jobs - # before starting any. - # Must be done after ungetting any --pipepart jobs. - $Global::JobQueue->total_jobs(); -} -# Compute $Global::max_jobs_running -# Must be done after ungetting any --pipepart jobs. -max_jobs_running(); - -init_run_jobs(); -my $sem; -if($Global::semaphore) { - $sem = acquire_semaphore(); -} -$SIG{TERM} = \&start_no_new_jobs; -start_more_jobs(); -if($opt::tee) { - # All jobs must be running in parallel for --tee - $Global::start_no_new_jobs = 1; -} elsif($opt::pipe and not $opt::pipepart) { - spreadstdin(); -} -::debug("init", "Start draining\n"); -drain_job_queue(); -::debug("init", "Done draining\n"); -reaper(); -::debug("init", "Done reaping\n"); -if($Global::semaphore) { - $sem->release(); -} -cleanup(); -::debug("init", "Halt\n"); -halt(); - -sub set_input_source_header { +sub set_input_source_header($$) { + my ($command_ref,$input_source_fh_ref) = @_; if($opt::header and not $opt::pipe) { # split with colsep or \t # $header force $colsep = \t if undef? @@ -152,15 +46,16 @@ sub set_input_source_header { my $right = "\Q$Global::parensright\E"; my $r = $Global::parensright; my $id = 1; - for my $fh (@input_source_fh) { + for my $fh (@$input_source_fh_ref) { my $line = <$fh>; chomp($line); ::debug("init", "Delimiter: '$delimiter'"); for my $s (split /$delimiter/o, $line) { ::debug("init", "Colname: '$s'"); # Replace {colname} with {2} - for(@command,@Global::ret_files,@Global::transfer_files, - $opt::tagstring, $opt::workdir, $opt::results, $opt::retries) { + for(@$command_ref,@Global::ret_files,@Global::transfer_files, + $opt::tagstring, $opt::workdir, $opt::results, + $opt::retries) { # Skip if undefined $_ or next; s:\{$s(|/|//|\.|/\.)\}:\{$id$1\}:g; @@ -173,28 +68,31 @@ sub set_input_source_header { } } else { my $id = 1; - for my $fh (@input_source_fh) { + for my $fh (@$input_source_fh_ref) { $Global::input_source_header{$id} = $id; $id++; } } } -sub max_jobs_running { +sub max_jobs_running() { # Compute $Global::max_jobs_running as the max number of jobs # running on each sshlogin. # Returns: # $Global::max_jobs_running if(not $Global::max_jobs_running) { - for my $sshlogin (values %Global::host) { $sshlogin->max_jobs_running(); } } + if(not $Global::max_jobs_running) { + ::error("Cannot run any jobs."); + wait_and_exit(255); + } return $Global::max_jobs_running; } -sub halt { +sub halt() { # Compute exit value, # wait for children to complete # and exit @@ -202,7 +100,8 @@ sub halt { if(not defined $Global::halt_exitstatus) { if($Global::halt_pct) { $Global::halt_exitstatus = - ::ceil($Global::total_failed / $Global::total_started * 100); + ::ceil($Global::total_failed / + ($Global::total_started || 1) * 100); } elsif($Global::halt_count) { $Global::halt_exitstatus = ::min(undef_as_zero($Global::total_failed),101); @@ -214,9 +113,11 @@ sub halt { } } -sub __PIPE_MODE__ {} -sub pipepart_setup { +sub __PIPE_MODE__() {} + + +sub pipepart_setup() { # Compute the blocksize # Generate the commands to extract the blocks # Push the commands on queue @@ -226,7 +127,7 @@ sub pipepart_setup { if($opt::tee) { # Prepend each command with # < file - my $cat_string = "< ".::shell_quote_scalar($opt::a[0]); + my $cat_string = "< ".Q($opt::a[0]); for(1..$Global::JobQueue->total_jobs()) { push @Global::cat_appends, $cat_string; push @Global::cat_prepends, ""; @@ -262,12 +163,12 @@ sub pipepart_setup { @Global::cat_prepends = map { pipe_part_files($_) } @opt::a; # Unget the empty arg as many times as there are parts $Global::JobQueue->{'commandlinequeue'}{'arg_queue'}->unget( - map { [Arg->new("\0")] } @Global::cat_prepends + map { [Arg->new("\0noarg")] } @Global::cat_prepends ); } } -sub pipe_tee_setup { +sub pipe_tee_setup() { # Create temporary fifos # Run 'tee fifo1 fifo2 fifo3 ... fifoN' in the background # This will spread the input to fifos @@ -295,7 +196,257 @@ sub pipe_tee_setup { @Global::cat_appends = map { ") < $_" } @fifos; } -sub pipe_part_files { + +sub parcat_script() { + # TODO if script fails: Use parallel -j0 --plain --lb cat ::: fifos + my $script = q'{ + use POSIX qw(:errno_h); + use IO::Select; + use strict; + use threads; + use Thread::Queue; + use Fcntl qw(:DEFAULT :flock); + + my $opened :shared; + my $q = Thread::Queue->new(); + my $okq = Thread::Queue->new(); + my @producers; + + if(not @ARGV) { + if(-t *STDIN) { + print "Usage:\n"; + print " parcat file(s)\n"; + print " cat argfile | parcat\n"; + } else { + # Read arguments from stdin + chomp(@ARGV = ); + } + } + my $files_to_open = 0; + # Default: fd = stdout + my $fd = 1; + for (@ARGV) { + # --rm = remove file when opened + /^--rm$/ and do { $opt::rm = 1; next; }; + # -1 = output to fd 1, -2 = output to fd 2 + /^-(\d+)$/ and do { $fd = $1; next; }; + push @producers, threads->create("producer", $_, $fd); + $files_to_open++; + } + + sub producer { + # Open a file/fifo, set non blocking, enqueue fileno of the file handle + my $file = shift; + my $output_fd = shift; + open(my $fh, "<", $file) || do { + print STDERR "parcat: Cannot open $file\n"; + exit(1); + }; + # Remove file when it has been opened + if($opt::rm) { + unlink $file; + } + set_fh_non_blocking($fh); + $opened++; + # Pass the fileno to parent + $q->enqueue(fileno($fh),$output_fd); + # Get an OK that the $fh is opened and we can release the $fh + while(1) { + my $ok = $okq->dequeue(); + if($ok == fileno($fh)) { last; } + # Not ours - very unlikely to happen + $okq->enqueue($ok); + } + return; + } + + my $s = IO::Select->new(); + my %buffer; + + sub add_file { + my $infd = shift; + my $outfd = shift; + open(my $infh, "<&=", $infd) || die; + open(my $outfh, ">&=", $outfd) || die; + $s->add($infh); + # Tell the producer now opened here and can be released + $okq->enqueue($infd); + # Initialize the buffer + @{$buffer{$infh}{$outfd}} = (); + $Global::fh{$outfd} = $outfh; + } + + sub add_files { + # Non-blocking dequeue + my ($infd,$outfd); + do { + ($infd,$outfd) = $q->dequeue_nb(2); + if(defined($outfd)) { + add_file($infd,$outfd); + } + } while(defined($outfd)); + } + + sub add_files_block { + # Blocking dequeue + my ($infd,$outfd) = $q->dequeue(2); + add_file($infd,$outfd); + } + + + my $fd; + my (@ready,$infh,$rv,$buf); + do { + # Wait until at least one file is opened + add_files_block(); + while($q->pending or keys %buffer) { + add_files(); + while(keys %buffer) { + @ready = $s->can_read(0.01); + if(not @ready) { + add_files(); + } + for $infh (@ready) { + # There is only one key, namely the output file descriptor + for my $outfd (keys %{$buffer{$infh}}) { + $rv = sysread($infh, $buf, 65536); + if (!$rv) { + if($! == EAGAIN) { + # Would block: Nothing read + next; + } else { + # Nothing read, but would not block: + # This file is done + $s->remove($infh); + for(@{$buffer{$infh}{$outfd}}) { + syswrite($Global::fh{$outfd},$_); + } + delete $buffer{$infh}; + # Closing the $infh causes it to block + # close $infh; + add_files(); + next; + } + } + # Something read. + # Find \n or \r for full line + my $i = (rindex($buf,"\n")+1); + if($i) { + # Print full line + for(@{$buffer{$infh}{$outfd}}, substr($buf,0,$i)) { + syswrite($Global::fh{$outfd},$_); + } + # @buffer = remaining half line + $buffer{$infh}{$outfd} = [substr($buf,$i,$rv-$i)]; + } else { + # Something read, but not a full line + push @{$buffer{$infh}{$outfd}}, $buf; + } + redo; + } + } + } + } + } while($opened < $files_to_open); + + for (@producers) { + $_->join(); + } + + sub set_fh_non_blocking { + # Set filehandle as non-blocking + # Inputs: + # $fh = filehandle to be blocking + # Returns: + # N/A + my $fh = shift; + my $flags; + fcntl($fh, &F_GETFL, $flags) || die $!; # Get the current flags on the filehandle + $flags |= &O_NONBLOCK; # Add non-blocking to the flags + fcntl($fh, &F_SETFL, $flags) || die $!; # Set the flags on the filehandle + } + }'; + return ::spacefree(3, $script); +} + +sub sharder_script() { + my $script = q{ + use B; + # Column separator + my $sep = shift; + # Which columns to shard on (count from 1) + my $col = shift; + # Which columns to shard on (count from 0) + my $col0 = $col - 1; + my $bins = @ARGV; + # Open fifos for writing, fh{0..$bins} + my $t = 0; + my %fh; + for(@ARGV) { + open $fh{$t++}, ">", $_; + # open blocks until it is opened by reader + # so unlink only happens when it is ready + unlink $_; + } + while() { + # Split into $col columns (no need to split into more) + @F = split $sep, $_, $col+1; + $fh = $fh{ hex(B::hash($F[$col0]))%$bins }; + print $fh $_; + } + # Close all open fifos + close values %fh; + }; + return ::spacefree(1, $script); +} + +sub pipe_shard_setup() { + # Create temporary fifos + # Run 'shard.pl sep col fifo1 fifo2 fifo3 ... fifoN' in the background + # This will spread the input to fifos + # Generate commands that reads from fifo1..N: + # cat fifo | user_command + # Changes: + # @Global::cat_prepends + my @shardfifos; + my @parcatfifos; + # TODO $opt::jobs should be evaluated (100%) + # TODO $opt::jobs should be number of total_jobs if there are argugemts + my $njobs = $opt::jobs; + for my $m (0..$njobs-1) { + for my $n (0..$njobs-1) { + # sharding to A B C D + # parcatting all As together + $parcatfifos[$n][$m] = $shardfifos[$m][$n] = tmpfifo(); + } + } + my $script = sharder_script(); + # cat foo | sharder sep col fifo1 fifo2 fifo3 ... fifoN + + if(not fork()) { + # Let the sharder inherit our stdin + # and redirect stdout to null + open STDOUT, ">","/dev/null"; + # The PERL_HASH_SEED must be the same for all sharders + # so B::hash will return the same value for any given input + $ENV{'PERL_HASH_SEED'} = $$; + exec qw(parallel --block 100k -q --pipe -j), $njobs, + qw(--roundrobin -u perl -e), $script, ($opt::colsep || ","), + $opt::shard, '{}', (map { (':::+', @{$_}) } @parcatfifos); + } + # For each fifo + # (rm fifo1; grep 1) < fifo1 + # (rm fifo2; grep 2) < fifo2 + # (rm fifo3; grep 3) < fifo3 + my $parcat = Q(parcat_script()); + if(not $parcat) { + ::error("'parcat' must be in path."); + ::wait_and_exit(255); + } + @Global::cat_prepends = map { "perl -e $parcat @$_ | " } @parcatfifos; +} + +sub pipe_part_files(@) { # Given the bigfile # find header and split positions # make commands that 'cat's the partial file @@ -321,7 +472,7 @@ sub pipe_part_files { return @cat_prepends; } -sub find_header { +sub find_header($$) { # Compute the header based on $opt::header # Input: # $buf_ref = reference to read-in buffer @@ -337,7 +488,8 @@ sub find_header { if($opt::header eq ":") { $opt::header = "(.*\n)"; } # Number = number of lines $opt::header =~ s/^(\d+)$/"(.*\n)"x$1/e; - while(read($fh,substr($$buf_ref,length $$buf_ref,0),$Global::blocksize)) { + while(read($fh,substr($$buf_ref,length $$buf_ref,0), + $Global::blocksize)) { if($$buf_ref=~s/^($opt::header)//) { $header = $1; last; @@ -347,7 +499,7 @@ sub find_header { return $header; } -sub find_split_positions { +sub find_split_positions($$$) { # Find positions in bigfile where recend is followed by recstart # Input: # $file = the file to read @@ -384,7 +536,7 @@ sub find_split_positions { while(read($fh,substr($buf,length $buf,0),$dd_block_size)) { if($opt::regexp) { # If match /$recend$recstart/ => Record position - if($buf =~ /^(.*$recend)$recstart/os) { + if($buf =~ m:^(.*$recend)$recstart:os) { # Start looking for next record _after_ this match $pos += length($1); push(@pos,$pos); @@ -414,7 +566,7 @@ sub find_split_positions { return @pos; } -sub cat_partial { +sub cat_partial($@) { # Efficient command to copy from byte X to byte Y # Input: # $file = the file to read @@ -441,11 +593,11 @@ sub cat_partial { } } }); - return "<". shell_quote_scalar($file) . + return "<". Q($file) . " perl -e '$script' @start_len |"; } -sub spreadstdin { +sub spreadstdin() { # read a record # Spawn a job and print the record to it. # Uses: @@ -460,15 +612,6 @@ sub spreadstdin { # %Global::running # Returns: N/A - if($opt::tee) { - # Spawn all jobs - # read a record - # Write record to all jobs - if(not $Global::JobQueue->empty()) { - ::error("--tee requres --jobs to be higher. Try --jobs 0."); - } - } - my $buf = ""; my ($recstart,$recend) = recstartrecend(); my $recendrecstart = $recend.$recstart; @@ -519,12 +662,19 @@ sub spreadstdin { $Global::max_number_of_args * ($Global::max_lines || 1); # (?!negative lookahead) is needed to avoid backtracking # See: https://unix.stackexchange.com/questions/439356/ - while($buf =~ /# From start up till recend - ^((?:(?!$recend$recstart).)*?$recend - # Then n-1 times recstart.*recend - (?:$recstart(?:(?!$recend$recstart).)*?$recend){$read_n_lines}) - # Followed by recstart - (?=$recstart)/osx) { + while($buf =~ + /( + # Either recstart or at least one char from start + ^(?: $recstart | .) + # followed something + (?:(?!$recend$recstart).)*? + # and then recend + $recend + # Then n-1 times recstart.*recend + (?:$recstart(?:(?!$recend$recstart).)*?$recend){$read_n_lines} + ) + # Followed by recstart + (?=$recstart)/osx) { $anything_written += write_record_to_pipe($chunk_number++,\$header,\$buf, $recstart,$recend,length $1); @@ -561,7 +711,9 @@ sub spreadstdin { my $i = 0; my $read_n_lines = $Global::max_number_of_args * ($Global::max_lines || 1); - while(($i = nindex(\$buf,$recendrecstart,$read_n_lines)) != -1) { + while(($i = nindex(\$buf,$recendrecstart,$read_n_lines)) != -1 + and + length $buf) { $i += length $recend; # find the actual splitting location $anything_written += write_record_to_pipe($chunk_number++,\$header,\$buf, @@ -615,6 +767,7 @@ sub spreadstdin { my $sleep =1; while($Global::total_running > 0) { $sleep = ::reap_usleep($sleep); + start_more_jobs(); } } $Global::start_no_new_jobs ||= 1; @@ -638,7 +791,7 @@ sub spreadstdin { } } -sub recstartrecend { +sub recstartrecend() { # Uses: # $opt::recstart # $opt::recend @@ -657,10 +810,15 @@ sub recstartrecend { # If --recend is given then it must match end of record $recstart = ""; $recend = $opt::recend; + if($opt::regexp and $recend eq '') { + # --regexp --recend '' + $recend = '.'; + } } if($opt::regexp) { - # If $recstart/$recend contains '|' this should only apply to the regexp + # If $recstart/$recend contains '|' + # this should only apply to the regexp $recstart = "(?:".$recstart.")"; $recend = "(?:".$recend.")"; } else { @@ -671,7 +829,7 @@ sub recstartrecend { return ($recstart,$recend); } -sub nindex { +sub nindex($$) { # See if string is in buffer N times # Returns: # the position where the Nth copy is found @@ -688,7 +846,7 @@ sub nindex { my @robin_queue; my $sleep = 1; - sub round_robin_write { + sub round_robin_write($$$$$) { # Input: # $header_ref = ref to $header string # $block_ref = ref to $block to be written @@ -714,45 +872,32 @@ sub nindex { push @robin_queue, (sort { $a->seq() <=> $b->seq() } values %Global::running); } - if($opt::keeporder) { + do { + $written = 0; for my $job (@robin_queue) { if($job->block_length() > 0) { $written += $job->non_blocking_write(); } else { - $job->set_block($header_ref,$buffer_ref,$endpos,$recstart,$recend); + $job->set_block($header_ref, $buffer_ref, + $endpos, $recstart, $recend); $block_passed = 1; $job->set_virgin(0); $written += $job->non_blocking_write(); last; } } - } else { - do { - $written = 0; - for my $job (@robin_queue) { - if($job->block_length() > 0) { - $written += $job->non_blocking_write(); - } else { - $job->set_block($header_ref,$buffer_ref, - $endpos,$recstart,$recend); - $block_passed = 1; - $job->set_virgin(0); - $written += $job->non_blocking_write(); - last; - } - } - if($written) { - $sleep = $sleep/1.5+0.001; - } - } while($written and not $block_passed); - } + if($written) { + $sleep = $sleep/1.5+0.001; + } + # Don't sleep if something is written + } while($written and not $block_passed); $sleep = ::reap_usleep($sleep); } return $written; } } -sub index64 { +sub index64($$$) { # Do index on strings > 2GB. # index in Perl < v5.22 does not work for > 2GB # Input: @@ -784,7 +929,7 @@ sub index64 { return -1; } -sub rindex64 { +sub rindex64($@) { # Do rindex on strings > 2GB. # rindex in Perl < v5.22 does not work for > 2GB # Input: @@ -825,7 +970,7 @@ sub rindex64 { return -1; } -sub shorten { +sub shorten($$) { # Do: substr($buf,0,$i) = ""; # Some Perl versions do not support $i > 2GB, so do this in 2GB chunks # Input: @@ -841,7 +986,7 @@ sub shorten { substr($$buf_ref,0,$i) = ""; } -sub write_record_to_pipe { +sub write_record_to_pipe($$$$$$) { # Fork then # Write record from pos 0 .. $endpos to pipe # Input: @@ -857,12 +1002,14 @@ sub write_record_to_pipe { # @Global::virgin_jobs # Returns: # Number of chunks written (0 or 1) - my ($chunk_number,$header_ref,$buffer_ref,$recstart,$recend,$endpos) = @_; + my ($chunk_number, $header_ref, $buffer_ref, + $recstart, $recend, $endpos) = @_; if($endpos == 0) { return 0; } if(vec($Global::job_already_run,$chunk_number,1)) { return 1; } if($opt::roundrobin) { # Write the block to one of the already running jobs - return round_robin_write($header_ref,$buffer_ref,$recstart,$recend,$endpos); + return round_robin_write($header_ref, $buffer_ref, + $recstart, $recend, $endpos); } # If no virgin found, backoff my $sleep = 0.0001; # 0.01 ms - better performance on highend @@ -882,7 +1029,8 @@ sub write_record_to_pipe { # Copy $buffer[0..$endpos] to $job->{'block'} # Remove rec_sep # Run $job->add_transfersize - $job->set_block($header_ref,$buffer_ref,$endpos,$recstart,$recend); + $job->set_block($header_ref, $buffer_ref, $endpos, + $recstart, $recend); if(fork()) { # Skip } else { @@ -901,7 +1049,7 @@ sub write_record_to_pipe { substr($$buffer_ref,$endpos,length $$buffer_ref) = ""; # Remove rec_sep if($opt::remove_rec_sep) { - Job::remove_rec_sep($buffer_ref,$recstart,$recend); + Job::remove_rec_sep($buffer_ref, $recstart, $recend); } $job->write($header_ref); $job->write($buffer_ref); @@ -914,17 +1062,18 @@ sub write_record_to_pipe { } -sub __SEM_MODE__ {} +sub __SEM_MODE__() {} -sub acquire_semaphore { +sub acquire_semaphore() { # Acquires semaphore. If needed: spawns to the background # Uses: # @Global::host # Returns: # The semaphore to be released when jobs is complete $Global::host{':'} = SSHLogin->new(":"); - my $sem = Semaphore->new($Semaphore::name,$Global::host{':'}->max_jobs_running()); + my $sem = Semaphore->new($Semaphore::name, + $Global::host{':'}->max_jobs_running()); $sem->acquire(); if($Semaphore::fg) { # skip @@ -940,10 +1089,10 @@ sub acquire_semaphore { } -sub __PARSE_OPTIONS__ {} +sub __PARSE_OPTIONS__() {} -sub options_hash { +sub options_hash() { # Returns: # %hash = the GetOptions config return @@ -967,7 +1116,8 @@ sub options_hash { "group" => \$opt::group, "g" => \$opt::retired, "ungroup|u" => \$opt::ungroup, - "linebuffer|linebuffered|line-buffer|line-buffered|lb" => \$opt::linebuffer, + "linebuffer|linebuffered|line-buffer|line-buffered|lb" + => \$opt::linebuffer, "tmux" => \$opt::tmux, "tmuxpane" => \$opt::tmuxpane, "null|0" => \$opt::null, @@ -991,9 +1141,15 @@ sub options_hash { "noswap" => \$opt::noswap, "max-line-length-allowed" => \$opt::max_line_length_allowed, "number-of-cpus" => \$opt::number_of_cpus, + "number-of-sockets" => \$opt::number_of_sockets, "number-of-cores" => \$opt::number_of_cores, + "number-of-threads" => \$opt::number_of_threads, + "use-sockets-instead-of-threads" + => \$opt::use_sockets_instead_of_threads, + "use-cores-instead-of-threads" + => \$opt::use_cores_instead_of_threads, "use-cpus-instead-of-cores" => \$opt::use_cpus_instead_of_cores, - "shellquote|shell_quote|shell-quote" => \$opt::shellquote, + "shellquote|shell_quote|shell-quote" => \@opt::shellquote, "nice=i" => \$opt::nice, "tag" => \$opt::tag, "tagstring|tag-string=s" => \$opt::tagstring, @@ -1019,7 +1175,8 @@ sub options_hash { "rsync-opts|rsyncopts=s" => \$opt::rsync_opts, "tmpdir|tempdir=s" => \$opt::tmpdir, "use-compress-program|compress-program=s" => \$opt::compress_program, - "use-decompress-program|decompress-program=s" => \$opt::decompress_program, + "use-decompress-program|decompress-program=s" + => \$opt::decompress_program, "compress" => \$opt::compress, "tty" => \$opt::tty, "T" => \$opt::retired, @@ -1049,6 +1206,8 @@ sub options_hash { "gnu" => \$opt::gnu, "link|xapply" => \$opt::link, "linkinputsource|xapplyinputsource=i" => \@opt::linkinputsource, + # Before changing this line, please read + # https://www.gnu.org/software/parallel/parallel_design.html#Citation-notice "bibtex|citation" => \$opt::citation, "wc|willcite|will-cite|nn|nonotice|no-notice" => \$opt::willcite, # Termination and retries @@ -1089,7 +1248,8 @@ sub options_hash { "wait" => \$opt::wait, # Shebang #!/opt/local/bin/parallel --shebang "shebang|hashbang" => \$opt::shebang, - "internal-pipe-means-argfiles" => \$opt::internal_pipe_means_argfiles, + "internal-pipe-means-argfiles" + => \$opt::internal_pipe_means_argfiles, "Y" => \$opt::retired, "skip-first-line" => \$opt::skip_first_line, "bug" => \$opt::bug, @@ -1098,12 +1258,13 @@ sub options_hash { "fifo" => \$opt::fifo, "pipepart|pipe-part" => \$opt::pipepart, "tee" => \$opt::tee, + "shard=s" => \$opt::shard, "hgrp|hostgrp|hostgroup|hostgroups" => \$opt::hostgroups, "embed" => \$opt::embed, ); } -sub get_options_from_array { +sub get_options_from_array($@) { # Run GetOptions on @array # Input: # $array_ref = ref to @ARGV to parse @@ -1145,12 +1306,14 @@ sub get_options_from_array { return $retval; } -sub parse_options { +sub parse_options(@) { # Returns: N/A init_globals(); my @argv_before = @ARGV; @ARGV = read_options(); + # Before changing this line, please read + # https://www.gnu.org/software/parallel/parallel_design.html#Citation-notice if(defined $opt::citation) { citation(\@argv_before,\@ARGV); wait_and_exit(0); @@ -1215,12 +1378,18 @@ sub parse_options { if(defined $opt::arg_file_sep) { $Global::arg_file_sep = $opt::arg_file_sep; } + if(defined $opt::number_of_sockets) { + print SSHLogin::no_of_sockets(),"\n"; wait_and_exit(0); + } if(defined $opt::number_of_cpus) { - print SSHLogin::no_of_cpus(),"\n"; wait_and_exit(0); + print SSHLogin::no_of_cores(),"\n"; wait_and_exit(0); } if(defined $opt::number_of_cores) { print SSHLogin::no_of_cores(),"\n"; wait_and_exit(0); } + if(defined $opt::number_of_threads) { + print SSHLogin::no_of_threads(),"\n"; wait_and_exit(0); + } if(defined $opt::max_line_length_allowed) { print Limits::Command::real_max_length(),"\n"; wait_and_exit(0); } @@ -1300,10 +1469,10 @@ sub parse_options { # Append a dummy empty argument if there are no arguments # on the command line to avoid reading from STDIN. # arg_sep = random 50 char - # \0 => nothing (not the empty string) + # \0noarg => nothing (not the empty string) $Global::arg_sep = join "", map { (0..9,"a".."z","A".."Z")[rand(62)] } (1..50); - push @ARGV, $Global::arg_sep, "\0"; + push @ARGV, $Global::arg_sep, "\0noarg"; } if(defined $opt::tee) { if(not defined $opt::jobs) { @@ -1374,9 +1543,85 @@ sub parse_options { if(defined $opt::eta) { $opt::progress = $opt::eta; } if(defined $opt::bar) { $opt::progress = $opt::bar; } + + # Funding a free software project is hard. GNU Parallel is no + # exception. On top of that it seems the less visible a project + # is, the harder it is to get funding. And the nature of GNU + # Parallel is that it will never be seen by "the guy with the + # checkbook", but only by the people doing the actual work. + # + # This problem has been covered by others - though no solution has + # been found: + # https://www.slideshare.net/NadiaEghbal/consider-the-maintainer + # https://www.numfocus.org/blog/why-is-numpy-only-now-getting-funded/ + # + # Before implementing the citation notice it was discussed with + # the users: + # https://lists.gnu.org/archive/html/parallel/2013-11/msg00006.html + # + # Having to spend 10 seconds on running 'parallel --citation' once + # is no doubt not an ideal solution, but no one has so far come up + # with an ideal solution - neither for funding GNU Parallel nor + # other free software. + # + # If you believe you have the perfect solution, you should try it + # out, and if it works, you should post it on the email + # list. Ideas that will cost work and which have not been tested + # are, however, unlikely to be prioritized. + # + # Please note that GPL version 3 gives you the right to fork GNU + # Parallel under a new name, but it does not give you the right to + # distribute modified copies with the citation notice disabled + # under the name GNU Parallel. To do that you need to be the owner + # of the GNU Parallel trademark. The xt:Commerce case shows this. + # + # Description of the xt:Commerce case in OLG Duesseldorf + # http://www.inta.org/INTABulletin/Pages/GERMANYGeneralPublicLicenseDoesNotPermitUseofThird-PartyTrademarksforAdvertisingModifiedVersionsofOpen-SourceSoftware.aspx + # https://web.archive.org/web/20180715073746/http://www.inta.org/INTABulletin/Pages/GERMANYGeneralPublicLicenseDoesNotPermitUseofThird-PartyTrademarksforAdvertisingModifiedVersionsofOpen-SourceSoftware.aspx + # + # The verdict in German + # https://www.admody.com/urteilsdatenbank/cafe6fdaeed3/OLG-Duesseldorf_Urteil_vom_28-September-2010_Az_I-20-U-41-09 + # https://web.archive.org/web/20180715073717/https://www.admody.com/urteilsdatenbank/cafe6fdaeed3/OLG-Duesseldorf_Urteil_vom_28-September-2010_Az_I-20-U-41-09 + # + # Other free software limiting derivates by the same name + # https://en.wikipedia.org/wiki/Red_Hat_Enterprise_Linux_derivatives#Legal_aspects + # https://tm.joomla.org/trademark-faq.html + # https://www.mozilla.org/en-US/foundation/trademarks/faq/ + # + # Running 'parallel --citation' one single time takes less than 10 + # seconds, and will silence the citation notice for future + # runs. If that is too much trouble for you, why not use one of + # the alternatives instead? + # See a list in: 'man parallel_alternatives' + # + # Please read the above before changing this line. citation_notice(); parse_halt(); + + if($ENV{'PARALLEL_ENV'}) { + # Read environment and set $Global::parallel_env + # Must be done before is_acceptable_command_line_length() + my $penv = $ENV{'PARALLEL_ENV'}; + # unset $PARALLEL_ENV: It should not be given to children + # because it takes up a lot of env space + delete $ENV{'PARALLEL_ENV'}; + if(-e $penv) { + # This is a file/fifo: Replace envvar with content of file + open(my $parallel_env, "<", $penv) || + ::die_bug("Cannot read parallel_env from $penv"); + local $/; # Put <> in slurp mode + $penv = <$parallel_env>; + close $parallel_env; + } + # Map \001 to \n to make it easer to quote \n in $PARALLEL_ENV + $penv =~ s/\001/\n/g; + if($penv =~ /\0/) { + ::warning('\0 (NUL) in environment is not supported'); + } + $Global::parallel_env = $penv; + } + parse_sshlogin(); if(remote_hosts() and ($opt::X or $opt::m or $opt::xargs)) { @@ -1395,7 +1640,7 @@ sub parse_options { if($opt::sqlworker) { $Global::membuffer ||= 1; } } -sub check_invalid_option_combinations { +sub check_invalid_option_combinations() { if(defined $opt::timeout and $opt::timeout !~ /^\d+(\.\d+)?%?$|^(\d+(\.\d+)?[dhms])+$/i) { ::error("--timeout must be seconds or percentage."); @@ -1448,9 +1693,9 @@ sub check_invalid_option_combinations { } } -sub init_globals { +sub init_globals() { # Defaults: - $Global::version = 20180622; + $Global::version = 20190322; $Global::progname = 'parallel'; $Global::infinity = 2**31; $Global::debug = 0; @@ -1521,9 +1766,8 @@ sub init_globals { $Global::trim = 'n'; $Global::max_jobs_running = 0; $Global::job_already_run = ''; - # LC_ALL workaround for multibyte chars containing special shell chars - $ENV{'LC_ALL'} = 'C'; $ENV{'TMPDIR'} ||= "/tmp"; + $ENV{'OLDPWD'} = $ENV{'PWD'}; if(not $ENV{HOME}) { # $ENV{HOME} is sometimes not set if called from PHP ::warning("\$HOME not set. Using /tmp."); @@ -1555,7 +1799,7 @@ sub init_globals { $ENV{'HOME'} . "/.parallel"; } -sub parse_halt { +sub parse_halt() { # $opt::halt flavours # Uses: # $opt::halt @@ -1607,7 +1851,7 @@ sub parse_halt { } } -sub parse_replacement_string_options { +sub parse_replacement_string_options() { # Deal with --rpl # Uses: # %Global::rpl @@ -1627,7 +1871,7 @@ sub parse_replacement_string_options { # $opt::slotreplace # $opt::basenameextensionreplace - sub rpl { + sub rpl($$) { # Modify %Global::rpl # Replace $old with $new my ($old,$new) = @_; @@ -1660,7 +1904,7 @@ sub parse_replacement_string_options { } } -sub parse_semaphore { +sub parse_semaphore() { # Semaphore defaults # Must be done before computing number of processes and max_line_length # because when running as a semaphore GNU Parallel does not read args @@ -1701,7 +1945,7 @@ sub parse_semaphore { @opt::a = ("/dev/null"); # Append a dummy empty argument # \0 => nothing (not the empty string) - push(@Global::unget_argv, [Arg->new("\0")]); + push(@Global::unget_argv, [Arg->new("\0noarg")]); $Semaphore::timeout = $opt::semaphoretimeout || 0; if(defined $opt::semaphorename) { $Semaphore::name = $opt::semaphorename; @@ -1724,7 +1968,7 @@ sub parse_semaphore { } } -sub record_env { +sub record_env() { # Record current %ENV-keys in $PARALLEL_HOME/ignored_vars # Returns: N/A my $ignore_filename = $Global::config_dir . "/ignored_vars"; @@ -1736,7 +1980,7 @@ sub record_env { } } -sub open_joblog { +sub open_joblog() { # Open joblog as specified by --joblog # Uses: # $opt::resume @@ -1765,6 +2009,8 @@ sub open_joblog { if($opt::resume || $opt::resume_failed || $opt::retry_failed) { if(open(my $joblog_fh, "<", $opt::joblog)) { # Read the joblog + # Override $/ with \n because -d might be set + local $/ = "\n"; # If there is a header: Open as append later $append = <$joblog_fh>; my $joblog_regexp; @@ -1773,22 +2019,19 @@ sub open_joblog { # 4 host 1360490623.067 3.445 1023 1222 0 0 command $joblog_regexp='^(\d+)(?:\t[^\t]+){5}\t0\t0\t'; my @group; - { - local $/ = "\n"; - while(<$joblog_fh>) { - if(/$joblog_regexp/o) { - # This is 30% faster than set_job_already_run($1); - vec($Global::job_already_run,($1||0),1) = 1; - $Global::total_completed++; - $group[$1-1] = "true"; - } elsif(/(\d+)\s+\S+(\s+[-0-9.]+){6}\s+(.*)$/) { - # Grab out the command - $group[$1-1] = $3; - } else { - chomp; - ::error("Format of '$opt::joblog' is wrong: $_"); - ::wait_and_exit(255); - } + while(<$joblog_fh>) { + if(/$joblog_regexp/o) { + # This is 30% faster than set_job_already_run($1); + vec($Global::job_already_run,($1||0),1) = 1; + $Global::total_completed++; + $group[$1-1] = "true"; + } elsif(/(\d+)\s+\S+(\s+[-0-9.]+){6}\s+(.*)$/) { + # Grab out the command + $group[$1-1] = $3; + } else { + chomp; + ::error("Format of '$opt::joblog' is wrong: $_"); + ::wait_and_exit(255); } } if(@group) { @@ -1802,7 +2045,7 @@ sub open_joblog { $/ = "\0"; } # Replace \0 with '\n' as used in print_joblog() - print $outfh map { s/\0/\n/g; $_,$/ } @group; + print $outfh map { s/\0/\n/g; $_,$/ } map { $_ } @group; seek $outfh, 0, 0; exit_if_disk_full(); # Set filehandle to -a @@ -1833,6 +2076,8 @@ sub open_joblog { } close $joblog_fh; } + # $opt::null may be set if the commands contain \n + if($opt::null) { $/ = "\0"; } } if($opt::dryrun) { # Do not write to joblog in a dry-run @@ -1863,7 +2108,7 @@ sub open_joblog { } } -sub open_csv { +sub open_csv() { if($opt::results) { # Output as CSV/TSV if($opt::results eq "-.csv" @@ -1888,7 +2133,7 @@ sub open_csv { } } -sub find_compression_program { +sub find_compression_program() { # Find a fast compression program # Returns: # $compress_program = compress program with options @@ -1932,7 +2177,7 @@ sub find_compression_program { return ("cat","cat"); } -sub read_options { +sub read_options() { # Read options from command line, profile and $PARALLEL # Uses: # $opt::shebang_wrap @@ -1957,7 +2202,7 @@ sub read_options { # remove --hashbang if it is set $opt::shebang .= ($ARGV[0] =~ s/^--hashbang *//); if($opt::shebang) { - my $argfile = shell_quote_scalar(pop @ARGV); + my $argfile = Q(pop @ARGV); # exec myself to split $ARGV[0] into separate fields exec "$0 --skip-first-line -a $argfile @ARGV"; } @@ -1980,7 +2225,7 @@ sub read_options { } else { @options = shift @ARGV; } - my $script = shell_quote_scalar(shift @ARGV); + my $script = Q(shift @ARGV); # exec myself to split $ARGV[0] into separate fields exec "$0 --internal-pipe-means-argfiles @options @parser $script ". "::: @ARGV"; @@ -2035,7 +2280,11 @@ sub read_options { } # Add options from shell variable $PARALLEL if($ENV{'PARALLEL'}) { - @ARGV_env = shell_words($ENV{'PARALLEL'}); + push @ARGV_env, shell_words($ENV{'PARALLEL'}); + } + # Add options from env_parallel.csh via $PARALLEL_CSH + if($ENV{'PARALLEL_CSH'}) { + push @ARGV_env, shell_words($ENV{'PARALLEL_CSH'}); } } Getopt::Long::Configure("bundling","require_order"); @@ -2051,11 +2300,13 @@ sub read_options { return @ARGV; } -sub arrayindex { +sub arrayindex() { # Similar to Perl's index function, but for arrays # Input: # $arr_ref1 = ref to @array1 to search in # $arr_ref2 = ref to @array2 to search for + # Returns: + # $pos = position of @array1 in @array2, -1 if not found my ($arr_ref1,$arr_ref2) = @_; my $array1_as_string = join "", map { "\0".$_ } @$arr_ref1; my $array2_as_string = join "", map { "\0".$_ } @$arr_ref2; @@ -2065,7 +2316,7 @@ sub arrayindex { return $#before; } -sub read_args_from_command_line { +sub read_args_from_command_line() { # Arguments given on the command line after: # ::: ($Global::arg_sep) # :::: ($Global::arg_file_sep) @@ -2157,7 +2408,7 @@ sub read_args_from_command_line { return @new_argv; } -sub cleanup { +sub cleanup() { # Returns: N/A unlink keys %Global::unlink; map { rmdir $_ } keys %Global::unlink; @@ -2169,20 +2420,17 @@ sub cleanup { } -sub __QUOTING_ARGUMENTS_FOR_SHELL__ {} +sub __QUOTING_ARGUMENTS_FOR_SHELL__() {} - -sub shell_quote { +sub shell_quote(@) { # Input: # @strings = strings to be quoted - # Output: - # @shell_quoted_strings = string quoted with \ as needed by the shell - return wantarray ? - (map { shell_quote_scalar($_) } @_) - : (join" ",map { shell_quote_scalar($_) } @_); + # Returns: + # @shell_quoted_strings = string quoted as needed by the shell + return wantarray ? (map { Q($_) } @_) : (join" ",map { Q($_) } @_); } -sub shell_quote_scalar_rc { +sub shell_quote_scalar_rc($) { # Quote for the rc-shell my $a = $_[0]; if(defined $a) { @@ -2200,7 +2448,7 @@ sub shell_quote_scalar_rc { return $a; } -sub shell_quote_scalar_csh { +sub shell_quote_scalar_csh($) { # Quote for (t)csh my $a = $_[0]; if(defined $a) { @@ -2221,30 +2469,27 @@ sub shell_quote_scalar_csh { return $a; } -sub shell_quote_scalar_default { - # Quote for other shells - my $a = $_[0]; - if(defined $a) { - # zsh wants '=' quoted - # Solaris sh wants ^ quoted. - # $a =~ s/([\002-\011\013-\032\\\#\?\`\(\)\{\}\[\]\^\*\>\<\~\|\; \"\!\$\&\'\202-\377])/\\$1/g; - # This is 1% faster than the above - if(($a =~ s/[\002-\011\013-\032\\\#\?\`\(\)\{\}\[\]\^\*\<\=\>\~\|\; \"\!\$\&\'\202-\377]/\\$&/go) - + - # quote newline as '\n' - ($a =~ s/[\n]/'\n'/go)) { - # A string was replaced - # No need to test for "" or \0 - } elsif($a eq "") { - $a = "''"; - } elsif($a eq "\0") { - $a = ""; - } +sub shell_quote_scalar_default($) { + # Quote for other shells (Bourne compatibles) + # Inputs: + # $string = string to be quoted + # Returns: + # $shell_quoted = string quoted as needed by the shell + my $par = $_[0]; + if($par =~ /[^-_.+a-z0-9\/]/i) { + $par =~ s/'/'"'"'/g; # "-quote single quotes + $par = "'$par'"; # '-quote entire string + $par =~ s/^''|''$//g; # Remove unneeded '' at ends + return $par; + } elsif ($par eq "") { + return "''"; + } else { + # No quoting needed + return $par; } - return $a; } -sub shell_quote_scalar { +sub shell_quote_scalar($) { # Quote the string so the shell will not expand any special chars # Inputs: # $string = string to be quoted @@ -2268,14 +2513,21 @@ sub shell_quote_scalar { return shell_quote_scalar(@_); } -sub shell_quote_file { +sub Q($) { + # Q alias for ::shell_quote_scalar + no warnings 'redefine'; + *Q = \&::shell_quote_scalar; + return Q(@_); +} + +sub shell_quote_file($) { # Quote the string so shell will not expand any special chars # and prepend ./ if needed # Input: # $filename = filename to be shell quoted # Returns: # $quoted_filename = filename quoted with \ and ./ if needed - my $a = shell_quote_scalar(shift); + my $a = shift; if(defined $a) { if($a =~ m:^/: or $a =~ m:^\./:) { # /abs/path or ./rel/path => skip @@ -2284,10 +2536,10 @@ sub shell_quote_file { $a = "./".$a; } } - return $a; + return Q($a); } -sub shell_words { +sub shell_words(@) { # Input: # $string = shell line # Returns: @@ -2296,7 +2548,7 @@ sub shell_words { return Text::ParseWords::shellwords(@_); } -sub perl_quote_scalar { +sub perl_quote_scalar($) { # Quote the string so perl's eval will not expand any special chars # Inputs: # $string = string to be quoted @@ -2309,8 +2561,19 @@ sub perl_quote_scalar { return $a; } -sub unquote_printf { +# -w complains about prototype +sub pQ($) { + # pQ alias for ::perl_quote_scalar + *pQ = \&::perl_quote_scalar; + return pQ(@_); +} + +sub unquote_printf() { # Convert \t \n \r \000 \0 + # Inputs: + # $string = string with \t \n \r \num \0 + # Returns: + # $replaced = string with TAB NEWLINE CR NUL $_ = shift; s/\\t/\t/g; s/\\n/\n/g; @@ -2321,10 +2584,10 @@ sub unquote_printf { } -sub __FILEHANDLES__ {} +sub __FILEHANDLES__() {} -sub save_stdin_stdout_stderr { +sub save_stdin_stdout_stderr() { # Remember the original STDIN, STDOUT and STDERR # and file descriptors opened by the shell (e.g. 3>/tmp/foo) # Uses: @@ -2354,7 +2617,7 @@ sub save_stdin_stdout_stderr { ::die_bug("Can't dup STDIN: $!"); } -sub enough_file_handles { +sub enough_file_handles() { # Check that we have enough filehandles available for starting # another job # Uses: @@ -2382,7 +2645,7 @@ sub enough_file_handles { } } -sub open_or_exit { +sub open_or_exit($) { # Open a file name or exit if the file cannot be opened # Inputs: # $file = filehandle or filename to open @@ -2406,7 +2669,7 @@ sub open_or_exit { return $fh; } -sub set_fh_blocking { +sub set_fh_blocking($) { # Set filehandle as blocking # Inputs: # $fh = filehandle to be blocking @@ -2423,7 +2686,7 @@ sub set_fh_blocking { fcntl($fh, &F_SETFL, $flags) || die $!; } -sub set_fh_non_blocking { +sub set_fh_non_blocking($) { # Set filehandle as non-blocking # Inputs: # $fh = filehandle to be blocking @@ -2441,7 +2704,7 @@ sub set_fh_non_blocking { } -sub __RUNNING_THE_JOBS_AND_PRINTING_PROGRESS__ {} +sub __RUNNING_THE_JOBS_AND_PRINTING_PROGRESS__() {} # Variable structure: @@ -2466,7 +2729,7 @@ sub __RUNNING_THE_JOBS_AND_PRINTING_PROGRESS__ {} # $Global::exitstatus = status code of GNU Parallel # $Global::quoting = quote the command to run -sub init_run_jobs { +sub init_run_jobs() { # Set Global variables and progress signal handlers # Do the copying of basefiles # Returns: N/A @@ -2560,7 +2823,6 @@ sub init_run_jobs { # Returns: # $jobs_started = number of jobs started my $jobs_started = 0; - my $jobs_started_this_round = 0; if($Global::start_no_new_jobs) { return $jobs_started; } @@ -2570,65 +2832,61 @@ sub init_run_jobs { changed_procs_file(); changed_sshloginfile(); } - do { - $jobs_started_this_round = 0; - # This will start 1 job on each --sshlogin (if possible) - # thus distribute the jobs on the --sshlogins round robin - for my $sshlogin (values %Global::host) { - if($Global::JobQueue->empty() and not $opt::pipe) { - # No more jobs in the queue - last; - } - debug("run", "Running jobs before on ", $sshlogin->string(), ": ", - $sshlogin->jobs_running(), "\n"); - if ($sshlogin->jobs_running() < $sshlogin->max_jobs_running()) { - if($opt::delay - and - $opt::delay > ::now() - $Global::newest_starttime) { - # It has been too short since last start - next; - } - if($opt::load and $sshlogin->loadavg_too_high()) { - # The load is too high or unknown - next; - } - if($opt::noswap and $sshlogin->swapping()) { - # The server is swapping - next; - } - if($opt::limit and $sshlogin->limit()) { - # Over limit - next; - } - if($opt::memfree and $sshlogin->memfree() < $opt::memfree) { - # The server has not enough mem free - ::debug("mem", "Not starting job: not enough mem\n"); - next; - } - if($sshlogin->too_fast_remote_login()) { - # It has been too short since - next; - } - debug("run", $sshlogin->string(), - " has ", $sshlogin->jobs_running(), - " out of ", $sshlogin->max_jobs_running(), - " jobs running. Start another.\n"); - if(start_another_job($sshlogin) == 0) { - # No more jobs to start on this $sshlogin - debug("run","No jobs started on ", - $sshlogin->string(), "\n"); - next; - } - $sshlogin->inc_jobs_running(); - $sshlogin->set_last_login_at(::now()); - $jobs_started++; - $jobs_started_this_round++; - } - debug("run","Running jobs after on ", $sshlogin->string(), ": ", - $sshlogin->jobs_running(), " of ", - $sshlogin->max_jobs_running(), "\n"); + # This will start 1 job on each --sshlogin (if possible) + # thus distribute the jobs on the --sshlogins round robin + for my $sshlogin (values %Global::host) { + if($Global::JobQueue->empty() and not $opt::pipe) { + # No more jobs in the queue + last; } - } while($jobs_started_this_round); + debug("run", "Running jobs before on ", $sshlogin->string(), ": ", + $sshlogin->jobs_running(), "\n"); + if ($sshlogin->jobs_running() < $sshlogin->max_jobs_running()) { + if($opt::delay + and + $opt::delay > ::now() - $Global::newest_starttime) { + # It has been too short since last start + next; + } + if($opt::load and $sshlogin->loadavg_too_high()) { + # The load is too high or unknown + next; + } + if($opt::noswap and $sshlogin->swapping()) { + # The server is swapping + next; + } + if($opt::limit and $sshlogin->limit()) { + # Over limit + next; + } + if($opt::memfree and $sshlogin->memfree() < $opt::memfree) { + # The server has not enough mem free + ::debug("mem", "Not starting job: not enough mem\n"); + next; + } + if($sshlogin->too_fast_remote_login()) { + # It has been too short since + next; + } + debug("run", $sshlogin->string(), + " has ", $sshlogin->jobs_running(), + " out of ", $sshlogin->max_jobs_running(), + " jobs running. Start another.\n"); + if(start_another_job($sshlogin) == 0) { + # No more jobs to start on this $sshlogin + debug("run","No jobs started on ", + $sshlogin->string(), "\n"); + next; + } + $sshlogin->inc_jobs_running(); + $sshlogin->set_last_login_at(::now()); + $jobs_started++; + } + debug("run","Running jobs after on ", $sshlogin->string(), ": ", + $sshlogin->jobs_running(), " of ", + $sshlogin->max_jobs_running(), "\n"); + } return $jobs_started; } @@ -2637,7 +2895,7 @@ sub init_run_jobs { { my $no_more_file_handles_warned; - sub start_another_job { + sub start_another_job() { # If there are enough filehandles # and JobQueue not empty # and not $job is in joblog @@ -2736,7 +2994,7 @@ sub init_run_jobs { } } -sub init_progress { +sub init_progress() { # Uses: # $opt::bar # Returns: @@ -2750,7 +3008,7 @@ sub init_progress { $progress{'workerlist'}); } -sub drain_job_queue { +sub drain_job_queue(@) { # Uses: # $opt::progress # $Global::total_running @@ -2760,6 +3018,7 @@ sub drain_job_queue { # %Global::host # $Global::start_no_new_jobs # Returns: N/A + my @command = @_; if($opt::progress) { ::status_no_nl(init_progress()); } @@ -2804,8 +3063,8 @@ sub drain_job_queue { } # * because of loadavg # * because of too little time between each ssh login. - start_more_jobs(); $sleep = ::reap_usleep($sleep); + start_more_jobs(); if($Global::max_jobs_running == 0) { ::warning("There are no job slots available. Increase --jobs."); } @@ -2813,6 +3072,7 @@ sub drain_job_queue { while($opt::sqlmaster and not $Global::sql->finished()) { # SQL master $sleep = ::reap_usleep($sleep); + start_more_jobs(); if($Global::start_sqlworker) { # Start an SQL worker as we are now sure there is work to do $Global::start_sqlworker = 0; @@ -2822,7 +3082,7 @@ sub drain_job_queue { # Replace --sql/--sqlandworker with --sqlworker my @ARGV = map { s/^--sql(andworker)?$/--sqlworker/; $_ } @Global::options_in_argv; # exec the --sqlworker - exec($0,::shell_quote(@ARGV),@command); + exec($0,@ARGV,@command); } } } @@ -2837,7 +3097,7 @@ sub drain_job_queue { } } -sub toggle_progress { +sub toggle_progress() { # Turn on/off progress view # Uses: # $opt::progress @@ -2848,7 +3108,7 @@ sub toggle_progress { } } -sub progress { +sub progress() { # Uses: # $opt::bar # $opt::eta @@ -3008,7 +3268,7 @@ sub progress { { - my ($total, $first_completed, $smoothed_avg_time, $last_eta); + my ($first_completed, $smoothed_avg_time, $last_eta); sub compute_eta { # Calculate important numbers for ETA @@ -3019,13 +3279,14 @@ sub progress { # $pctcomplete = percent of jobs completed # $avgtime = averaged time # $eta = smoothed eta - $total = $Global::JobQueue->total_jobs(); my $completed = $Global::total_completed; + # In rare cases with -X will $completed > total_jobs() + my $total = ::max($Global::JobQueue->total_jobs(),$completed); my $left = $total - $completed; if(not $completed) { return($total, $completed, $left, 0, 0, 0); } - my $pctcomplete = $completed / $total; + my $pctcomplete = ::min($completed / $total,100); $first_completed ||= time; my $timepassed = (time - $first_completed); my $avgtime = $timepassed / $completed; @@ -3047,7 +3308,7 @@ sub progress { { my ($rev,$reset); - sub bar { + sub bar() { # Return: # $status = bar with eta, completed jobs, arg and pct $rev ||= "\033[7m"; @@ -3081,7 +3342,7 @@ sub progress { { my ($columns,$last_column_time); - sub terminal_columns { + sub terminal_columns() { # Get the number of columns of the terminal. # Only update once per second. # Returns: @@ -3111,7 +3372,9 @@ sub progress { } } -sub get_job_with_sshlogin { +# Prototype forwarding +sub get_job_with_sshlogin($); +sub get_job_with_sshlogin($) { # Input: # $sshlogin = which host should the job be run on? # Uses: @@ -3148,19 +3411,8 @@ sub get_job_with_sshlogin { return undef; } } - - my $clean_command = $job->replaced(); - if($clean_command =~ /^\s*$/) { - # Do not run empty lines - if(not $Global::JobQueue->empty()) { - return get_job_with_sshlogin($sshlogin); - } else { - return undef; - } - } $job->set_sshlogin($sshlogin); - if($opt::retries and $clean_command and - $job->failed_here()) { + if($opt::retries and $job->failed_here()) { # This command with these args failed for this sshlogin my ($no_of_failed_sshlogins,$min_failures) = $job->min_failed(); # Only look at the Global::host that have > 0 jobslots @@ -3187,10 +3439,10 @@ sub get_job_with_sshlogin { } -sub __REMOTE_SSH__ {} +sub __REMOTE_SSH__() {} -sub read_sshloginfiles { +sub read_sshloginfiles(@) { # Read a list of --slf's # Input: # @files = files or symbolic file names to read @@ -3200,7 +3452,7 @@ sub read_sshloginfiles { } } -sub expand_slf_shorthand { +sub expand_slf_shorthand($) { # Expand --slf shorthand into a read file name # Input: # $file = file or symbolic file name to read @@ -3228,7 +3480,7 @@ sub expand_slf_shorthand { return $file; } -sub read_sshloginfile { +sub read_sshloginfile($) { # Read sshloginfile into @Global::sshlogin # Input: # $file = file to read @@ -3261,7 +3513,7 @@ sub read_sshloginfile { } } -sub parse_sshlogin { +sub parse_sshlogin() { # Parse @Global::sshlogin into %Global::host. # Keep only hosts that are in one of the given ssh hostgroups. # Uses: @@ -3346,7 +3598,7 @@ sub parse_sshlogin { } } -sub remote_hosts { +sub remote_hosts() { # Return sshlogins that are not ':' # Uses: # %Global::host @@ -3355,7 +3607,7 @@ sub remote_hosts { return grep !/^:$/, keys %Global::host; } -sub setup_basefile { +sub setup_basefile() { # Transfer basefiles to each $sshlogin # This needs to be done before first jobs on $sshlogin is run # Uses: @@ -3391,7 +3643,7 @@ sub setup_basefile { } } -sub cleanup_basefile { +sub cleanup_basefile() { # Remove the basefiles transferred # Uses: # %Global::host @@ -3421,14 +3673,14 @@ sub cleanup_basefile { } } -sub run_parallel { +sub run_parallel() { my ($stdin,@args) = @_; my $cmd = join "",map { " $_ & " } split /\n/, $stdin; print $Global::original_stderr ` $cmd wait` ; return 0 } -sub _run_parallel { +sub _run_parallel() { # Run GNU Parallel # This should ideally just fork an internal copy # and not start it through a shell @@ -3472,18 +3724,20 @@ sub _run_parallel { return ($exitstatus,\@stdout,\@stderr); } -sub filter_hosts { +sub filter_hosts() { # Remove down --sshlogins from active duty. # Find ncpus, ncores, maxlen, time-to-login for each host. # Uses: # %Global::host # $Global::minimal_command_line_length + # $opt::use_sockets_instead_of_threads + # $opt::use_cores_instead_of_threads # $opt::use_cpus_instead_of_cores # Returns: N/A - my ($ncores_ref, $ncpus_ref, $time_to_login_ref, $maxlen_ref, - $echo_ref, $down_hosts_ref) = - parse_host_filtering(parallelized_host_filtering()); + my ($nsockets_ref,$ncores_ref, $nthreads_ref, $time_to_login_ref, + $maxlen_ref, $echo_ref, $down_hosts_ref) = + parse_host_filtering(parallelized_host_filtering()); delete @Global::host{@$down_hosts_ref}; @$down_hosts_ref and ::warning("Removed @$down_hosts_ref."); @@ -3491,17 +3745,22 @@ sub filter_hosts { $Global::minimal_command_line_length = 8_000_000; while (my ($sshlogin, $obj) = each %Global::host) { if($sshlogin eq ":") { next } - $ncpus_ref->{$sshlogin} or - ::die_bug("ncpus missing: ".$obj->serverlogin()); + $nsockets_ref->{$sshlogin} or + ::die_bug("nsockets missing: ".$obj->serverlogin()); $ncores_ref->{$sshlogin} or ::die_bug("ncores missing: ".$obj->serverlogin()); + $nthreads_ref->{$sshlogin} or + ::die_bug("nthreads missing: ".$obj->serverlogin()); $time_to_login_ref->{$sshlogin} or ::die_bug("time_to_login missing: ".$obj->serverlogin()); $maxlen_ref->{$sshlogin} or ::die_bug("maxlen missing: ".$obj->serverlogin()); + $obj->set_ncpus($nthreads_ref->{$sshlogin}); if($opt::use_cpus_instead_of_cores) { - $obj->set_ncpus($ncpus_ref->{$sshlogin}); - } else { + $obj->set_ncpus($ncores_ref->{$sshlogin}); + } elsif($opt::use_sockets_instead_of_threads) { + $obj->set_ncpus($nsockets_ref->{$sshlogin}); + } elsif($opt::use_cores_instead_of_threads) { $obj->set_ncpus($ncores_ref->{$sshlogin}); } $obj->set_time_to_login($time_to_login_ref->{$sshlogin}); @@ -3510,28 +3769,31 @@ sub filter_hosts { ::min($Global::minimal_command_line_length, int($maxlen_ref->{$sshlogin}/2)); ::debug("init", "Timing from -S:$sshlogin ", - " ncpus:",$ncpus_ref->{$sshlogin}, + " nsockets:",$nsockets_ref->{$sshlogin}, " ncores:", $ncores_ref->{$sshlogin}, + " nthreads:",$nthreads_ref->{$sshlogin}, " time_to_login:", $time_to_login_ref->{$sshlogin}, " maxlen:", $maxlen_ref->{$sshlogin}, " min_max_len:", $Global::minimal_command_line_length,"\n"); } } -sub parse_host_filtering { +sub parse_host_filtering() { # Input: # @lines = output from parallelized_host_filtering() # Returns: + # \%nsockets = number of sockets of {host} # \%ncores = number of cores of {host} - # \%ncpus = number of cpus of {host} + # \%nthreads = number of hyperthreaded cores of {host} # \%time_to_login = time_to_login on {host} # \%maxlen = max command len on {host} # \%echo = echo received from {host} # \@down_hosts = list of hosts with no answer local $/ = "\n"; - my (%ncores, %ncpus, %time_to_login, %maxlen, %echo, @down_hosts); + my (%nsockets, %ncores, %nthreads, %time_to_login, %maxlen, %echo, + @down_hosts); for (@_) { - ::debug("init",$_); + ::debug("init","Read: ",$_); chomp; my @col = split /\t/, $_; if($col[0] =~ /^parallel: Warning:/) { @@ -3547,7 +3809,7 @@ sub parse_host_filtering { next; } # Get server from: eval true server\; - $col[8] =~ /eval true..([^;]+).;/ or + $col[8] =~ /eval .?true.?\s([^\;]+);/ or ::die_bug("col8 does not contain host: $col[8]"); my $host = $1; $host =~ tr/\\//d; @@ -3560,11 +3822,12 @@ sub parse_host_filtering { push(@down_hosts, $host); } elsif($col[6] eq "127") { # signal == 127: parallel not installed remote - # Set ncpus and ncores = 1 + # Set nsockets, ncores, nthreads = 1 ::warning("Could not figure out ". "number of cpus on $host. Using 1."); + $nsockets{$host} = 1; $ncores{$host} = 1; - $ncpus{$host} = 1; + $nthreads{$host} = 1; $maxlen{$host} = Limits::Command::max_length(); } elsif($col[0] =~ /^\d+$/ and $Global::host{$host}) { # Remember how log it took to log in @@ -3582,10 +3845,12 @@ sub parse_host_filtering { if(/parallel: Warning: Cannot figure out number of/) { next; } - if(not $ncores{$col[0]}) { + if(not $nsockets{$col[0]}) { + $nsockets{$col[0]} = $col[1]; + } elsif(not $ncores{$col[0]}) { $ncores{$col[0]} = $col[1]; - } elsif(not $ncpus{$col[0]}) { - $ncpus{$col[0]} = $col[1]; + } elsif(not $nthreads{$col[0]}) { + $nthreads{$col[0]} = $col[1]; } elsif(not $maxlen{$col[0]}) { $maxlen{$col[0]} = $col[1]; } elsif(not $echo{$col[0]}) { @@ -3607,10 +3872,11 @@ sub parse_host_filtering { } } @down_hosts = uniq(@down_hosts); - return(\%ncores, \%ncpus, \%time_to_login, \%maxlen, \%echo, \@down_hosts); + return(\%nsockets, \%ncores, \%nthreads, \%time_to_login, + \%maxlen, \%echo, \@down_hosts); } -sub parallelized_host_filtering { +sub parallelized_host_filtering() { # Uses: # %Global::host # Returns: @@ -3632,14 +3898,16 @@ sub parallelized_host_filtering { return($job->{'wrapped'}); } - my(@cores, @cpus, @maxline, @echo); + my(@sockets, @cores, @threads, @maxline, @echo); while (my ($host, $sshlogin) = each %Global::host) { if($host eq ":") { next } # The 'true' is used to get the $host out later + push(@sockets, $host."\t"."true $host; ". + sshwrapped($sshlogin,"parallel --number-of-sockets")."\n\0"); push(@cores, $host."\t"."true $host; ". sshwrapped($sshlogin,"parallel --number-of-cores")."\n\0"); - push(@cpus, $host."\t"."true $host; ". - sshwrapped($sshlogin,"parallel --number-of-cpus")."\n\0"); + push(@threads, $host."\t"."true $host; ". + sshwrapped($sshlogin,"parallel --number-of-threads")."\n\0"); push(@maxline, $host."\t"."true $host; ". sshwrapped($sshlogin,"parallel --max-line-length-allowed")."\n\0"); # 'echo' is used to get the fastest possible ssh login time @@ -3656,7 +3924,7 @@ sub parallelized_host_filtering { my $cmd = "$0 -j0 --timeout 10 --joblog - --plain --delay 0.1 --retries 3 ". "--tag --tagstring '{1}' -0 --colsep '\t' -k eval '{2}' && true "; - $cmd = $Global::shell." -c ".::shell_quote_scalar($cmd); + $cmd = $Global::shell." -c ".Q($cmd); ::debug("init", $cmd, "\n"); my @out; my $prepend = ""; @@ -3666,18 +3934,19 @@ sub parallelized_host_filtering { if(not fork()) { # Give the commands to run to the $cmd close $host_fh; - print $in @cores, @cpus, @maxline, @echo; + print $in @sockets, @cores, @threads, @maxline, @echo; close $in; exit(); } close $in; for(<$host_fh>) { - if(/\'$/) { - # if last char = ' then append next line - # This may be due to quoting of \n in environment var - $prepend .= $_; - next; - } + # TODO incompatible with '-quoting. Needs to be fixed differently + #if(/\'$/) { + # # if last char = ' then append next line + # # This may be due to quoting of \n in environment var + # $prepend .= $_; + # next; + #} $_ = $prepend . $_; $prepend = ""; push @out, $_; @@ -3686,7 +3955,7 @@ sub parallelized_host_filtering { return @out; } -sub onall { +sub onall($@) { # Runs @command on all hosts. # Uses parallel to run @command on each host. # --jobs = number of hosts to run on simultaneously. @@ -3757,6 +4026,7 @@ sub onall { # -P should only go to the first, and -S should not be copied at all. my $options = join(" ", + ((defined $opt::memfree) ? "--memfree ".$opt::memfree : ""), ((defined $opt::D) ? "-D $opt::D" : ""), ((defined $opt::group) ? "-g" : ""), ((defined $opt::jobs) ? "-P $opt::jobs" : ""), @@ -3784,16 +4054,16 @@ sub onall { ((defined $opt::timeout) ? "--timeout ".$opt::timeout : ""), ((defined $opt::ungroup) ? "-u" : ""), ((defined $opt::tee) ? "--tee" : ""), - ((defined $opt::workdir) ? "--wd ".::shell_quote_scalar($opt::workdir) : ""), - (@Global::transfer_files ? map { "--tf ".::shell_quote_scalar($_) } + ((defined $opt::workdir) ? "--wd ".Q($opt::workdir) : ""), + (@Global::transfer_files ? map { "--tf ".Q($_) } @Global::transfer_files : ""), - (@Global::ret_files ? map { "--return ".::shell_quote_scalar($_) } + (@Global::ret_files ? map { "--return ".Q($_) } @Global::ret_files : ""), - (@opt::env ? map { "--env ".::shell_quote_scalar($_) } @opt::env : ""), + (@opt::env ? map { "--env ".Q($_) } @opt::env : ""), (map { "-v" } @opt::v), ); ::debug("init", "| $0 $options\n"); - open(my $parallel_fh, "|-", "$0 --will-cite -j0 $options") || + open(my $parallel_fh, "|-", "$0 -0 --will-cite -j0 $options") || ::die_bug("This does not run GNU Parallel: $0 $options"); my @joblogs; for my $host (sort keys %Global::host) { @@ -3804,16 +4074,20 @@ sub onall { $joblog = "--joblog $joblog"; } my $quad = $opt::arg_file_sep || "::::"; - ::debug("init", "$0 $suboptions -j1 $joblog ", + # If PARALLEL_ENV is set: Pass it on + my $penv=$Global::parallel_env ? + "PARALLEL_ENV=".Q($Global::parallel_env) : + ''; + ::debug("init", "$penv $0 $suboptions -j1 $joblog ", ((defined $opt::tag) ? - "--tagstring ".shell_quote_scalar($sshlogin->string()) : ""), - " -S ", shell_quote_scalar($sshlogin->string())," ", + "--tagstring ".Q($sshlogin->string()) : ""), + " -S ", Q($sshlogin->string())," ", join(" ",shell_quote(@command))," $quad @argfiles\n"); - print $parallel_fh "$0 $suboptions -j1 $joblog ", + print $parallel_fh "$penv $0 $suboptions -j1 $joblog ", ((defined $opt::tag) ? - "--tagstring ".shell_quote_scalar($sshlogin->string()) : ""), - " -S ", shell_quote_scalar($sshlogin->string())," ", - join(" ",shell_quote(@command))," $quad @argfiles\n"; + "--tagstring ".Q($sshlogin->string()) : ""), + " -S ", Q($sshlogin->string())," ", + join(" ",shell_quote(@command))," $quad @argfiles\0"; } close $parallel_fh; $Global::exitstatus = $? >> 8; @@ -3833,10 +4107,10 @@ sub onall { } -sub __SIGNAL_HANDLING__ {} +sub __SIGNAL_HANDLING__() {} -sub sigtstp { +sub sigtstp() { # Send TSTP signal (Ctrl-Z) to all children process groups # Uses: # %SIG @@ -3844,7 +4118,7 @@ sub sigtstp { signal_children("TSTP"); } -sub sigpipe { +sub sigpipe() { # Send SIGPIPE signal to all children process groups # Uses: # %SIG @@ -3852,7 +4126,7 @@ sub sigpipe { signal_children("PIPE"); } -sub signal_children { +sub signal_children() { # Send signal to all children process groups # and GNU Parallel itself # Uses: @@ -3866,7 +4140,7 @@ sub signal_children { kill $signal, $$; } -sub save_original_signal_handler { +sub save_original_signal_handler() { # Remember the original signal handler # Uses: # %Global::original_sig @@ -3893,7 +4167,7 @@ sub save_original_signal_handler { }; } -sub list_running_jobs { +sub list_running_jobs() { # Print running jobs on tty # Uses: # %Global::running @@ -3903,121 +4177,130 @@ sub list_running_jobs { } } -sub start_no_new_jobs { +sub start_no_new_jobs() { # Start no more jobs # Uses: # %Global::original_sig # %Global::unlink # $Global::start_no_new_jobs # Returns: N/A - $SIG{TERM} = $Global::original_sig{TERM}; +# $SIG{TERM} = $Global::original_sig{TERM}; unlink keys %Global::unlink; ::status - ("$Global::progname: SIGTERM received. No new jobs will be started.", + ("$Global::progname: SIGHUP received. No new jobs will be started.", "$Global::progname: Waiting for these ".(keys %Global::running). - " jobs to finish. Send SIGTERM again to stop now."); + " jobs to finish. Send SIGTERM to stop now."); list_running_jobs(); $Global::start_no_new_jobs ||= 1; } -sub reaper { - # A job finished. - # Print the output. - # Start another job +sub reapers() { + # Run reaper until there are no more left + # Returns: + # @pids_reaped = pids of reaped processes + my @pids_reaped; + my $pid; + while($pid = reaper()) { + push @pids_reaped, $pid; + } + return @pids_reaped; +} + +sub reaper() { + # A job finished: + # * Set exitstatus, exitsignal, endtime. + # * Free ressources for new job + # * Update median runtime + # * Print output + # * If --halt = now: Kill children + # * Print progress # Uses: - # %Global::sshmaster # %Global::running # $opt::timeout # $Global::timeoutq - # $opt::halt # $opt::keeporder # $Global::total_running # Returns: - # @pids_reaped = PIDs of children finished + # $stiff = PID of child finished my $stiff; - my @pids_reaped; - my $children_reaped = 0; debug("run", "Reaper "); - # For efficiency surround with BEGIN/COMMIT when using $opt::sqlmaster - $opt::sqlmaster and $Global::sql->run("BEGIN;"); - while (($stiff = waitpid(-1, &WNOHANG)) > 0) { - # $stiff = pid of dead process - if(wantarray) { - push(@pids_reaped,$stiff); - } else { - $children_reaped++; - } - if($Global::sshmaster{$stiff}) { - # This is one of the ssh -M: ignore - next; - } - my $job = $Global::running{$stiff}; + if(($stiff = waitpid(-1, &WNOHANG)) <= 0) { + # No jobs waiting to be reaped + return 0; + } - # '-a <(seq 10)' will give us a pid not in %Global::running - $job or next; - delete $Global::running{$stiff}; - $Global::total_running--; - if($job->{'commandline'}{'skip'}) { - # $job->skip() was called - $job->set_exitstatus(-2); - $job->set_exitsignal(0); - } else { - $job->set_exitstatus($? >> 8); - $job->set_exitsignal($? & 127); - } + # $stiff = pid of dead process + my $job = $Global::running{$stiff}; - debug("run", "seq ",$job->seq()," died (", $job->exitstatus(), ")"); - $job->set_endtime(::now()); - my $sshlogin = $job->sshlogin(); - $sshlogin->dec_jobs_running(); - if($job->should_be_retried()) { - $job->free_ressources(); + # '-a <(seq 10)' will give us a pid not in %Global::running + # The same will one of the ssh -M: ignore + $job or return 0; + delete $Global::running{$stiff}; + $Global::total_running--; + if($job->{'commandline'}{'skip'}) { + # $job->skip() was called + $job->set_exitstatus(-2); + $job->set_exitsignal(0); + } else { + $job->set_exitstatus($? >> 8); + $job->set_exitsignal($? & 127); + } + + debug("run", "seq ",$job->seq()," died (", $job->exitstatus(), ")"); + $job->set_endtime(::now()); + my $sshlogin = $job->sshlogin(); + $sshlogin->dec_jobs_running(); + if($job->should_be_retried()) { + # Free up file handles + $job->free_ressources(); + } else { + # The job is done + $sshlogin->inc_jobs_completed(); + # Free the jobslot + $job->free_slot(); + if($opt::timeout and not $job->exitstatus()) { + # Update average runtime for timeout only for successful jobs + $Global::timeoutq->update_median_runtime($job->runtime()); + } + if($opt::keeporder) { + $job->print_earlier_jobs(); } else { - # The job is done - $sshlogin->inc_jobs_completed(); - # Free the jobslot - $job->free_slot(); - if($opt::timeout and not $job->exitstatus()) { - # Update average runtime for timeout only for successful jobs - $Global::timeoutq->update_median_runtime($job->runtime()); - } - if($opt::keeporder) { - $job->print_earlier_jobs(); - } else { - $job->print(); - } - if($job->should_we_halt() eq "now") { - # Kill children - ::kill_sleep_seq($job->pid()); - ::killall(); - ::wait_and_exit($Global::halt_exitstatus); - } - } - $job->cleanup(); - start_more_jobs(); - if($opt::progress) { - my %progress = progress(); - ::status_no_nl("\r",$progress{'status'}); + $job->print(); + } + if($job->should_we_halt() eq "now") { + # Kill children + ::kill_sleep_seq($job->pid()); + ::killall(); + ::wait_and_exit($Global::halt_exitstatus); } } - $opt::sqlmaster and $Global::sql->run("COMMIT;"); + $job->cleanup(); + + if($opt::progress) { + my %progress = progress(); + ::status_no_nl("\r",$progress{'status'}); + } + debug("run", "done "); - return wantarray ? @pids_reaped : $children_reaped; + return $stiff; } -sub __USAGE__ {} +sub __USAGE__() {} -sub killall { +sub killall() { # Kill all jobs by killing their process groups - + # Uses: + # $Global::start_no_new_jobs = we are stopping + # $Global::killall = Flag to not run reaper $Global::start_no_new_jobs ||= 1; + # Do not reap killed children: Ignore them instead $Global::killall ||= 1; kill_sleep_seq(keys %Global::running); } -sub kill_sleep_seq { +sub kill_sleep_seq(@) { # Send jobs TERM,TERM,KILL to processgroups # Input: # @pids = list of pids that are also processgroups @@ -4032,41 +4315,41 @@ sub kill_sleep_seq { } } -sub kill_sleep { +sub kill_sleep() { + # Kill pids with a signal and wait a while for them to die + # Input: + # $signal = signal to send to @pids + # $sleep_max = number of ms to sleep at most before returning + # @pids = pids to kill (actually process groups) + # Uses: + # $Global::killall = set by killall() to avoid calling reaper + # Returns: + # @pids = pids still alive my ($signal, $sleep_max, @pids) = @_; ::debug("kill","kill_sleep $signal ",(join " ",sort @pids),"\n"); kill $signal, @pids; my $sleepsum = 0; my $sleep = 0.001; - my @dead; while(@pids and $sleepsum < $sleep_max) { if($Global::killall) { # Killall => don't run reaper - my $stiff; - while (($stiff = waitpid(-1, &WNOHANG)) > 0) { - # remove $stiff from @pids - @pids = grep { $_ != $stiff } @pids; + while(waitpid(-1, &WNOHANG) > 0) { $sleep = $sleep/2+0.001; } - } elsif(@dead = reaper()) { - # Remove reaped pids - for my $stiff (@dead) { - @pids = grep { $_ != $stiff } @pids; - } + } elsif(reapers()) { $sleep = $sleep/2+0.001; } - @pids = grep { kill( 0, $_) } @pids; $sleep *= 1.1; ::usleep($sleep); $sleepsum += $sleep; - # Remove dead children - @pids = grep { kill( 0, $_) } @pids; + # Keep only living children + @pids = grep { kill(0, $_) } @pids; } return @pids; } -sub wait_and_exit { +sub wait_and_exit($) { # If we do not wait, we sometimes get segfault # Returns: N/A my $error = shift; @@ -4076,7 +4359,7 @@ sub wait_and_exit { killall(); } for (keys %Global::unkilled_children) { - # Kill any (non-jobs) children + # Kill any (non-jobs) children (e.g. reserved processes) kill 9, $_; waitpid($_,0); delete $Global::unkilled_children{$_}; @@ -4087,13 +4370,13 @@ sub wait_and_exit { exit($error); } -sub die_usage { +sub die_usage() { # Returns: N/A usage(); wait_and_exit(255); } -sub usage { +sub usage() { # Returns: N/A print join ("\n", @@ -4131,13 +4414,15 @@ sub usage { " O. Tange (2018): GNU Parallel 2018, Mar 2018, ISBN 9781387509881,", " DOI https://doi.org/10.5281/zenodo.1146014", "", + # Before changing this line, please read + # https://www.gnu.org/software/parallel/parallel_design.html#Citation-notice "This helps funding further development; AND IT WON'T COST YOU A CENT.", "If you pay 10000 EUR you should feel free to use GNU Parallel without citing.", "", "",); } -sub citation_notice { +sub citation_notice() { # if --will-cite or --plain: do nothing # if stderr redirected: do nothing # if $PARALLEL_HOME/will-cite: do nothing @@ -4159,6 +4444,8 @@ sub citation_notice { " O. Tange (2018): GNU Parallel 2018, Mar 2018, ISBN 9781387509881,", " DOI https://doi.org/10.5281/zenodo.1146014", "", + # Before changing this line, please read + # https://www.gnu.org/software/parallel/parallel_design.html#Citation-notice "This helps funding further development; AND IT WON'T COST YOU A CENT.", "If you pay 10000 EUR you should feel free to use GNU Parallel without citing.", "", @@ -4168,36 +4455,56 @@ sub citation_notice { "To silence this citation notice: run 'parallel --citation' once.", "" ); + mkdir $Global::config_dir; + # Number of times the user has run GNU Parallel without showing + # willingness to cite + my $runs = 0; + if(open (my $fh, "<", $Global::config_dir. + "/runs-without-willing-to-cite")) { + $runs = <$fh>; + close $fh; + } + $runs++; + if(open (my $fh, ">", $Global::config_dir. + "/runs-without-willing-to-cite")) { + print $fh $runs; + close $fh; + if($runs >= 10) { + ::status("Come on: You have run parallel $runs times. Isn't it about time ", + "you run 'parallel --citation' once to silence the citation notice?", + ""); + } + } } } -sub status { +sub status(@) { my @w = @_; my $fh = $Global::status_fd || *STDERR; print $fh map { ($_, "\n") } @w; flush $fh; } -sub status_no_nl { +sub status_no_nl(@) { my @w = @_; my $fh = $Global::status_fd || *STDERR; print $fh @w; flush $fh; } -sub warning { +sub warning(@) { my @w = @_; my $prog = $Global::progname || "parallel"; status_no_nl(map { ($prog, ": Warning: ", $_, "\n"); } @w); } -sub error { +sub error(@) { my @w = @_; my $prog = $Global::progname || "parallel"; status(map { ($prog.": Error: ". $_); } @w); } -sub die_bug { +sub die_bug($) { my $bugid = shift; print STDERR ("$Global::progname: This should not happen. You have found a bug.\n", @@ -4214,23 +4521,23 @@ sub die_bug { ::wait_and_exit(255); } -sub version { +sub version() { # Returns: N/A - print join("\n", - "GNU $Global::progname $Global::version", - "Copyright (C) 2007,2008,2009,2010,2011,2012,2013,2014,2015,2016,2017,2018", - "Ole Tange and Free Software Foundation, Inc.", - "License GPLv3+: GNU GPL version 3 or later ", - "This is free software: you are free to change and redistribute it.", - "GNU $Global::progname comes with no warranty.", - "", - "Web site: http://www.gnu.org/software/${Global::progname}\n", - "When using programs that use GNU Parallel to process data for publication", - "please cite as described in 'parallel --citation'.\n", + print join + ("\n", + "GNU $Global::progname $Global::version", + "Copyright (C) 2007-2019 Ole Tange and Free Software Foundation, Inc.", + "License GPLv3+: GNU GPL version 3 or later ", + "This is free software: you are free to change and redistribute it.", + "GNU $Global::progname comes with no warranty.", + "", + "Web site: http://www.gnu.org/software/${Global::progname}\n", + "When using programs that use GNU Parallel to process data for publication", + "please cite as described in 'parallel --citation'.\n", ); } -sub citation { +sub citation() { # Returns: N/A my ($all_argv_ref,$argv_options_removed_ref) = @_; my $all_argv = "@$all_argv_ref"; @@ -4259,11 +4566,16 @@ sub citation { "", "(Feel free to use \\nocite{tange_ole_2018_1146014})", "", + # Before changing this line, please read + # https://www.gnu.org/software/parallel/parallel_design.html#Citation-notice + # https://git.savannah.gnu.org/cgit/parallel.git/tree/doc/citation-notice-faq.txt "This helps funding further development; AND IT WON'T COST YOU A CENT.", "If you pay 10000 EUR you should feel free to use GNU Parallel without citing.", "", "More about funding GNU Parallel and the citation notice:", + "https://lists.gnu.org/archive/html/parallel/2013-11/msg00006.html", "https://www.gnu.org/software/parallel/parallel_design.html#Citation-notice", + "https://git.savannah.gnu.org/cgit/parallel.git/tree/doc/citation-notice-faq.txt", "", "If you send a copy of your published article to tange\@gnu.org, it will be", "mentioned in the release notes of next version of GNU Parallel.", @@ -4281,8 +4593,13 @@ sub citation { close $fh; ::status( "", - "Thank you for your support. It is much appreciated. The citation", - "notice is now silenced.", + "Thank you for your support: You are the reason why there is funding to", + "continue maintaining GNU Parallel. On behalf of future versions of", + "GNU Parallel, which would not exist without your support:", + "", + " THANK YOU SO MUCH", + "", + "It is really appreciated. The citation notice is now silenced.", ""); } else { ::status( @@ -4303,7 +4620,7 @@ sub citation { } } -sub show_limits { +sub show_limits() { # Returns: N/A print("Maximal size of command: ",Limits::Command::real_max_length(),"\n", "Maximal used size of command: ",Limits::Command::max_length(),"\n", @@ -4313,7 +4630,7 @@ sub show_limits { "press CTRL-D or CTRL-C\n"); } -sub embed { +sub embed() { # Give an embeddable version of GNU Parallel # Tested with: bash, zsh, ksh, ash, dash, sh my $randomstring = "cut-here-".join"", @@ -4339,8 +4656,8 @@ sub embed { } print "#!$Global::shell -# Copyright (C) 2007,2008,2009,2010,2011,2012,2013,2014,2015,2016, -# 2017,2018 $user, Ole Tange and Free Software Foundation, Inc. +# Copyright (C) 2007-2019 $user, Ole Tange and Free Software +# Foundation, Inc. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -4415,10 +4732,11 @@ echo $p $y $c $h " $0 --embed > new_script"); } -sub __GENERIC_COMMON_FUNCTION__ {} + +sub __GENERIC_COMMON_FUNCTION__() {} -sub mkdir_or_die { +sub mkdir_or_die($) { # If dir is not executable: die my $dir = shift; # The eval is needed to catch exception from mkdir @@ -4429,7 +4747,7 @@ sub mkdir_or_die { } } -sub tmpfile { +sub tmpfile(@) { # Create tempfile as $TMPDIR/parXXXXX # Returns: # $filehandle = opened file handle @@ -4445,7 +4763,7 @@ sub tmpfile { } } -sub tmpname { +sub tmpname($) { # Select a name that does not exist # Do not create the file as it may be used for creating a socket (by tmux) # Remember the name in $Global::unlink to avoid hitting the same name twice @@ -4466,15 +4784,15 @@ sub tmpname { return $tmpname; } -sub tmpfifo { +sub tmpfifo() { # Find an unused name and mkfifo on it use POSIX qw(mkfifo); - my $tmpfifo = tmpname("fif",@_); + my $tmpfifo = tmpname("fif"); mkfifo($tmpfifo,0600); return $tmpfifo; } -sub rm { +sub rm(@) { # Remove file and remove it from %Global::unlink # Uses: # %Global::unlink @@ -4482,7 +4800,7 @@ sub rm { unlink @_; } -sub size_of_block_dev { +sub size_of_block_dev() { # Like -s but for block devices # Input: # $blockdev = file name of block device @@ -4500,7 +4818,7 @@ sub size_of_block_dev { } } -sub qqx { +sub qqx(@) { # Like qx but with clean environment (except for @keep) # and STDERR ignored # This is needed if the environment contains functions @@ -4521,12 +4839,12 @@ sub qqx { } } -sub uniq { +sub uniq(@) { # Remove duplicates and return unique values return keys %{{ map { $_ => 1 } @_ }}; } -sub min { +sub min(@) { # Returns: # Minimum value of array my $min; @@ -4539,7 +4857,7 @@ sub min { return $min; } -sub max { +sub max(@) { # Returns: # Maximum value of array my $max; @@ -4552,7 +4870,7 @@ sub max { return $max; } -sub sum { +sub sum() { # Returns: # Sum of values of array my @args = @_; @@ -4564,24 +4882,24 @@ sub sum { return $sum; } -sub undef_as_zero { +sub undef_as_zero($) { my $a = shift; return $a ? $a : 0; } -sub undef_as_empty { +sub undef_as_empty($) { my $a = shift; return $a ? $a : ""; } -sub undef_if_empty { +sub undef_if_empty($) { if(defined($_[0]) and $_[0] eq "") { return undef; } return $_[0]; } -sub multiply_binary_prefix { +sub multiply_binary_prefix(@) { # Evalualte numbers with binary prefix # Ki=2^10, Mi=2^20, Gi=2^30, Ti=2^40, Pi=2^50, Ei=2^70, Zi=2^80, Yi=2^80 # ki=2^10, mi=2^20, gi=2^30, ti=2^40, pi=2^50, ei=2^70, zi=2^80, yi=2^80 @@ -4630,7 +4948,7 @@ sub multiply_binary_prefix { return wantarray ? @v : $v[0]; } -sub multiply_time_units { +sub multiply_time_units($) { # Evalualte numbers with time units # s=1, m=60, h=3600, d=86400 # Input: @@ -4651,7 +4969,7 @@ sub multiply_time_units { return wantarray ? @v : $v[0]; } -sub seconds_to_time_units { +sub seconds_to_time_units() { # Convert seconds into ??d??h??m??s # s=1, m=60, h=3600, d=86400 # Input: @@ -4680,7 +4998,7 @@ sub seconds_to_time_units { { my ($disk_full_fh, $b8193, $error_printed); - sub exit_if_disk_full { + sub exit_if_disk_full() { # Checks if $TMPDIR is full by writing 8kb to a tmpfile # If the disk is full: Exit immediately. # Returns: @@ -4724,7 +5042,7 @@ sub seconds_to_time_units { } } -sub spacefree { +sub spacefree($$) { # Remove comments and spaces # Inputs: # $spaces = keep 1 space? @@ -4740,6 +5058,10 @@ sub spacefree { # Keep newlines $s =~ s/\n\n+/\n/sg; $s =~ s/[ \t]+/ /mg; + } elsif(3 == $spaces) { + # Keep perl code required space + $s =~ s{([^a-zA-Z0-9/])\s+}{$1}sg; + $s =~ s{([a-zA-Z0-9/])\s+([^:a-zA-Z0-9/])}{$1$2}sg; } else { $s =~ s/\s//mg; } @@ -4748,7 +5070,7 @@ sub spacefree { { my $hostname; - sub hostname { + sub hostname() { local $/ = "\n"; if(not $hostname) { $hostname = `hostname`; @@ -4759,7 +5081,7 @@ sub spacefree { } } -sub which { +sub which(@) { # Input: # @programs = programs to find the path to # Returns: @@ -4774,7 +5096,7 @@ sub which { push(@which, grep { not -d $_ and -x $_ } $prg); } } - return @which; + return wantarray ? @which : $which[0]; } { @@ -4811,7 +5133,7 @@ sub which { # csh and tcsh disguise themselves as -sh/-csh # E.g.: ssh -tt csh@lo 'ps aux;true' |egrep ^csh # but sh also disguise itself as -sh - # (When?) + # (TODO When does that happen?) "-sh" => ["sh"], "-csh" => ["tcsh", "csh"], # ash disguises itself as -ash @@ -4820,7 +5142,7 @@ sub which { "-dash" => ["dash", "ash", "sh"], # bash disguises itself as -bash "-bash" => ["bash", "sh"], - # ksh disguises itself as -ash + # ksh disguises itself as -ksh "-ksh" => ["ksh", "sh"], # zsh disguises itself as -zsh "-zsh" => ["zsh", "sh"], @@ -4862,7 +5184,7 @@ sub which { { my %pid_parentpid_cmd; - sub pid_table { + sub pid_table() { # Returns: # %children_of = { pid -> children of pid } # %parent_of = { pid -> pid of parent } @@ -4872,9 +5194,10 @@ sub which { # Filter for SysV-style `ps` my $sysv = q( ps -ef | perl -ane '1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;). q(s/^.{$s}//; print "@F[1,2] $_"' ); - # Crazy msys: ' is not accepted on the cmd line, but " are treated as ' - my $msys = q( ps -ef | perl -ane "1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;). - q(s/^.{$s}//; print qq{@F[1,2] $_}" ); + # Minix uses cols 2,3 and can have newlines in the command + # so lines not having numbers in cols 2,3 must be ignored + my $minix = q( ps -ef | perl -ane '1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;). + q(s/^.{$s}// and $F[2]>0 and $F[3]>0 and print "@F[2,3] $_"' ); # BSD-style `ps` my $bsd = q(ps -o pid,ppid,command -ax); %pid_parentpid_cmd = @@ -4890,7 +5213,8 @@ sub which { 'hpux' => $sysv, 'linux' => $sysv, 'mirbsd' => $bsd, - 'msys' => $msys, + 'minix' => $minix, + 'msys' => $sysv, 'MSWin32' => $sysv, 'netbsd' => $bsd, 'nto' => $sysv, @@ -4925,7 +5249,7 @@ sub which { } } -sub now { +sub now() { # Returns time since epoch as in seconds with 3 decimals # Uses: # @Global::use @@ -4943,7 +5267,7 @@ sub now { return (int(TimeHiRestime()*1000))/1000; } -sub usleep { +sub usleep($) { # Sleep this many milliseconds. # Input: # $ms = milliseconds to sleep @@ -4952,7 +5276,8 @@ sub usleep { select(undef, undef, undef, $ms/1000); } -sub reap_usleep { +sub __KILLER_REAPER__() {} +sub reap_usleep() { # Reap dead children. # If no dead children: Sleep specified amount with exponential backoff # Input: @@ -4961,7 +5286,7 @@ sub reap_usleep { # $ms/2+0.001 if children reaped # $ms*1.1 if no children reaped my $ms = shift; - if(reaper()) { + if(reapers()) { if(not $Global::total_completed % 100) { if($opt::timeout) { # Force cleaning the timeout queue for every 1000 jobs @@ -5010,7 +5335,7 @@ sub reap_usleep { } } -sub kill_youngest_if_over_limit { +sub kill_youngest_if_over_limit() { # Check each $sshlogin we are over limit # If over limit: kill off the youngest child # Put the child back in the queue. @@ -5035,7 +5360,7 @@ sub kill_youngest_if_over_limit { } } -sub kill_youngster_if_not_enough_mem { +sub kill_youngster_if_not_enough_mem() { # Check each $sshlogin if there is enough mem. # If less than 50% enough free mem: kill off the youngest child # Put the child back in the queue. @@ -5070,10 +5395,10 @@ sub kill_youngster_if_not_enough_mem { } -sub __DEBUGGING__ {} +sub __DEBUGGING__() {} -sub debug { +sub debug(@) { # Uses: # $Global::debug # %Global::fd @@ -5091,7 +5416,7 @@ sub debug { } } -sub my_memory_usage { +sub my_memory_usage() { # Returns: # memory usage if found # 0 otherwise @@ -5115,7 +5440,7 @@ sub my_memory_usage { } } -sub my_size { +sub my_size() { # Returns: # $size = size of object if Devel::Size is installed # -1 otherwise @@ -5128,7 +5453,7 @@ sub my_size { } } -sub my_dump { +sub my_dump(@) { # Returns: # ascii expression of object if Data::Dump(er) is installed # error code otherwise @@ -5154,25 +5479,25 @@ sub my_dump { } } -sub my_croak { +sub my_croak(@) { eval "use Carp; 1"; $Carp::Verbose = 1; croak(@_); } -sub my_carp { +sub my_carp() { eval "use Carp; 1"; $Carp::Verbose = 1; carp(@_); } -sub __OBJECT_ORIENTED_PARTS__ {} +sub __OBJECT_ORIENTED_PARTS__() {} package SSHLogin; -sub new { +sub new($$) { my $class = shift; my $sshlogin_string = shift; my $ncpus; @@ -5226,49 +5551,49 @@ sub new { }, ref($class) || $class; } -sub DESTROY { +sub DESTROY($) { my $self = shift; # Remove temporary files if they are created. ::rm($self->{'loadavg_file'}); ::rm($self->{'swap_activity_file'}); } -sub string { +sub string($) { my $self = shift; return $self->{'string'}; } -sub jobs_running { +sub jobs_running($) { my $self = shift; return ($self->{'jobs_running'} || "0"); } -sub inc_jobs_running { +sub inc_jobs_running($) { my $self = shift; $self->{'jobs_running'}++; } -sub dec_jobs_running { +sub dec_jobs_running($) { my $self = shift; $self->{'jobs_running'}--; } -sub set_maxlength { +sub set_maxlength($$) { my $self = shift; $self->{'maxlength'} = shift; } -sub maxlength { +sub maxlength($) { my $self = shift; return $self->{'maxlength'}; } -sub jobs_completed { +sub jobs_completed() { my $self = shift; return $self->{'jobs_completed'}; } -sub in_hostgroups { +sub in_hostgroups() { # Input: # @hostgroups = the hostgroups to look for # Returns: @@ -5278,18 +5603,18 @@ sub in_hostgroups { return grep { defined $self->{'hostgroups'}{$_} } @_; } -sub hostgroups { +sub hostgroups() { my $self = shift; return keys %{$self->{'hostgroups'}}; } -sub inc_jobs_completed { +sub inc_jobs_completed($) { my $self = shift; $self->{'jobs_completed'}++; $Global::total_completed++; } -sub set_max_jobs_running { +sub set_max_jobs_running($$) { my $self = shift; if(defined $self->{'max_jobs_running'}) { $Global::max_jobs_running -= $self->{'max_jobs_running'}; @@ -5303,15 +5628,16 @@ sub set_max_jobs_running { $self->{'orig_max_jobs_running'} ||= $self->{'max_jobs_running'}; } -sub memfree { +sub memfree() { # Returns: # $memfree in bytes my $self = shift; $self->memfree_recompute(); + # Return 1 if not defined. return (not defined $self->{'memfree'} or $self->{'memfree'}) } -sub memfree_recompute { +sub memfree_recompute() { my $self = shift; my $script = memfreescript(); @@ -5327,7 +5653,7 @@ sub memfree_recompute { { my $script; - sub memfreescript { + sub memfreescript() { # Returns: # shellscript for giving available memory in bytes if(not $script) { @@ -5342,6 +5668,13 @@ sub memfree_recompute { q[ awk '/^((Swap)?Cached|MemFree|Buffers):/ ]. q[ { sum += \$2} END { print sum }' ]. q[ /proc/meminfo } ], + # Android uses same code as GNU/Linux + "android" => + q[ print 1024 * qx{ ]. + q[ awk '/^((Swap)?Cached|MemFree|Buffers):/ ]. + q[ { sum += \$2} END { print sum }' ]. + q[ /proc/meminfo } ], + # $ vmstat 1 1 # procs memory page faults cpu # r b w avm free re at pi po fr de sr in sy cs us sy id @@ -5397,13 +5730,13 @@ sub memfree_recompute { $perlscript .= 'if($^O eq "'.$os.'") { '.$script_of{$os}.'}'; } $perlscript =~ s/[\t\n ]+/ /g; - $script = "perl -e " . ::shell_quote_scalar($perlscript); + $script = "perl -e " . ::Q($perlscript); } return $script; } } -sub limit { +sub limit($) { # Returns: # 0 = Below limit. Start another job. # 1 = Over limit. Start no jobs. @@ -5474,13 +5807,13 @@ sub limit { } -sub swapping { +sub swapping($) { my $self = shift; my $swapping = $self->swap_activity(); return (not defined $swapping or $swapping) } -sub swap_activity { +sub swap_activity($) { # If the currently known swap activity is too old: # Recompute a new one in the background # Returns: @@ -5489,7 +5822,8 @@ sub swap_activity { # Should we update the swap_activity file? my $update_swap_activity_file = 0; if(-r $self->{'swap_activity_file'}) { - open(my $swap_fh, "<", $self->{'swap_activity_file'}) || ::die_bug("swap_activity_file-r"); + open(my $swap_fh, "<", $self->{'swap_activity_file'}) || + ::die_bug("swap_activity_file-r"); my $swap_out = <$swap_fh>; close $swap_fh; if($swap_out =~ /^(\d+)$/) { @@ -5516,7 +5850,7 @@ sub swap_activity { $swap_activity = swapactivityscript(); if($self->{'string'} ne ":") { $swap_activity = $self->sshcommand() . " " . $self->serverlogin() . " " . - ::shell_quote_scalar($swap_activity); + ::Q($swap_activity); } # Run swap_activity measuring. # As the command can take long to run if run remote @@ -5532,7 +5866,7 @@ sub swap_activity { { my $script; - sub swapactivityscript { + sub swapactivityscript() { # Returns: # shellscript for detecting swap activity # @@ -5653,13 +5987,13 @@ sub swap_activity { $perlscript .= 'if($^O eq "'.$os.'") { print `'.$vmstat{$os}[0].' | awk "{print ' . $vmstat{$os}[1] . '}"` }'; } - $script = "perl -e " . ::shell_quote_scalar($perlscript); + $script = "perl -e " . ::Q($perlscript); } return $script; } } -sub too_fast_remote_login { +sub too_fast_remote_login($) { my $self = shift; if($self->{'last_login_at'} and $self->{'time_to_login'}) { # sshd normally allows 10 simultaneous logins @@ -5676,26 +6010,31 @@ sub too_fast_remote_login { } } -sub last_login_at { +sub last_login_at($) { my $self = shift; return $self->{'last_login_at'}; } -sub set_last_login_at { +sub set_last_login_at($$) { my $self = shift; $self->{'last_login_at'} = shift; } -sub loadavg_too_high { +sub loadavg_too_high($) { my $self = shift; my $loadavg = $self->loadavg(); - return (not defined $loadavg or - $loadavg > $self->max_loadavg()); + if(defined $loadavg) { + ::debug("load", "Load $loadavg > ",$self->max_loadavg()); + return $loadavg >= $self->max_loadavg(); + } else { + # Unknown load: Assume load is too high + return 1; + } } { my $cmd; - sub loadavg_cmd { + sub loadavg_cmd() { if(not $cmd) { # aix => "ps -ae -o state,command" # state wrong # bsd => "ps ax -o state,command" @@ -5730,8 +6069,9 @@ sub loadavg_too_high { awk '{print $2,$1}' }; $dummy="echo S COMMAND;echo R dummy"; %ps=( - # TODO Find better code for AIX + # TODO Find better code for AIX/Android 'aix' => "uptime", + 'android' => "uptime", 'cygwin' => $cygwin, 'darwin' => $bsd, 'dec_osf' => $sysv2, @@ -5744,13 +6084,13 @@ sub loadavg_too_high { 'minix' => "ps el|awk '{print \$1,\$11}'", 'mirbsd' => $bsd, 'msys' => $cygwin, - 'MSWin32' => $sysv, 'netbsd' => $bsd, 'nto' => $dummy, 'openbsd' => $bsd, 'solaris' => $sysv, 'svr5' => $psel, 'ultrix' => "ps -ax | awk '{print \$3,\$5}'", + 'MSWin32' => $sysv, ); print `$ps{$^O}`; }); @@ -5762,7 +6102,7 @@ sub loadavg_too_high { } -sub loadavg { +sub loadavg($) { # If the currently know loadavg is too old: # Recompute a new one in the background # The load average is computed as the number of processes waiting for disk @@ -5813,13 +6153,13 @@ sub loadavg { my $cmd = ""; if($self->{'string'} ne ":") { $cmd = $self->sshcommand() . " " . $self->serverlogin() . " " . - ::shell_quote_scalar(loadavg_cmd()); + ::Q(loadavg_cmd()); } else { $cmd .= loadavg_cmd(); } # As the command can take long to run if run remote # save it to a tmp file before moving it to the correct file - ::debug("load", "Cmd: ", $cmd,"\n"); + ::debug("load", "Update load\n"); my $file = $self->{'loadavg_file'}; # tmpfile on same filesystem as $file my $tmpfile = $file.$$; @@ -5828,7 +6168,7 @@ sub loadavg { return $self->{'loadavg'}; } -sub max_loadavg { +sub max_loadavg($) { my $self = shift; # If --load is a file it might be changed if($Global::max_load_file) { @@ -5848,12 +6188,12 @@ sub max_loadavg { return $self->{'max_loadavg'}; } -sub set_max_loadavg { +sub set_max_loadavg($$) { my $self = shift; $self->{'max_loadavg'} = shift; } -sub compute_max_loadavg { +sub compute_max_loadavg($) { # Parse the max loadaverage that the user asked for using --load # Returns: # max loadaverage @@ -5899,17 +6239,17 @@ sub compute_max_loadavg { return $load; } -sub time_to_login { +sub time_to_login($) { my $self = shift; return $self->{'time_to_login'}; } -sub set_time_to_login { +sub set_time_to_login($$) { my $self = shift; $self->{'time_to_login'} = shift; } -sub max_jobs_running { +sub max_jobs_running($) { my $self = shift; if(not defined $self->{'max_jobs_running'}) { my $nproc = $self->compute_number_of_processes($opt::jobs); @@ -5918,12 +6258,12 @@ sub max_jobs_running { return $self->{'max_jobs_running'}; } -sub orig_max_jobs_running { +sub orig_max_jobs_running($) { my $self = shift; return $self->{'orig_max_jobs_running'}; } -sub compute_number_of_processes { +sub compute_number_of_processes($) { # Number of processes wanted and limited by system resources # Returns: # Number of processes @@ -5952,7 +6292,7 @@ sub compute_number_of_processes { my @args; my $arg; - sub reserve_filehandles { + sub reserve_filehandles($) { # Reserves filehandle my $n = shift; for (1..$n) { @@ -5960,7 +6300,7 @@ sub compute_number_of_processes { } } - sub reserve_process { + sub reserve_process() { # Spawn a dummy process my $child; if($child = fork()) { @@ -5971,8 +6311,8 @@ sub compute_number_of_processes { # The child takes one process slot # It will be killed later $SIG{'TERM'} = $Global::original_sig{'TERM'}; - if($^O eq "cygwin" or $^O eq "msys") { - # The exec does not work on Cygwin + if($^O eq "cygwin" or $^O eq "msys" or $^O eq "nto") { + # The exec does not work on Cygwin and QNX sleep 10101010; } else { # 'exec sleep' takes less RAM than sleeping in perl @@ -5985,7 +6325,7 @@ sub compute_number_of_processes { } } - sub get_args_or_jobs { + sub get_args_or_jobs() { # Get an arg or a job (depending on mode) if($Global::semaphore or ($opt::pipe and not $opt::tee)) { # Skip: No need to get args @@ -6020,6 +6360,8 @@ sub compute_number_of_processes { return 0; } else { $job = $Global::JobQueue->get(); + # Replacement must happen here due to seq() + $job and $job->replaced(); push(@jobs, $job); return 1; } @@ -6027,7 +6369,7 @@ sub compute_number_of_processes { } } - sub cleanup { + sub cleanup() { # Cleanup: Close the files for (values %fh) { close $_ } # Cleanup: Kill the children @@ -6043,7 +6385,7 @@ sub compute_number_of_processes { @jobs = (); } - sub processes_available_by_system_limit { + sub processes_available_by_system_limit($) { # If the wanted number of processes is bigger than the system limits: # Limit them to the system limits # Limits are: File handles, number of input lines, processes, @@ -6145,7 +6487,7 @@ sub compute_number_of_processes { } } -sub simultaneous_sshlogin_limit { +sub simultaneous_sshlogin_limit($) { # Test by logging in wanted number of times simultaneously # Returns: # min($wanted_processes,$working_simultaneous_ssh_logins-1) @@ -6164,7 +6506,7 @@ sub simultaneous_sshlogin_limit { my $serverlogin = $self->serverlogin(); ::warning("ssh to $serverlogin only allows ". "for $ssh_limit simultaneous logins.", - "You may raise this by changing ". + "You may raise this by changing", "/etc/ssh/sshd_config:MaxStartups and MaxSessions on $serverlogin.", "You can also try --sshdelay 0.1", "Using only ".($ssh_limit-1)." connections ". @@ -6175,12 +6517,15 @@ sub simultaneous_sshlogin_limit { return $ssh_limit; } -sub simultaneous_sshlogin { +sub simultaneous_sshlogin($) { # Using $sshlogin try to see if we can do $wanted_processes # simultaneous logins - # (ssh host echo simultaneouslogin & ssh host echo simultaneouslogin & ...)|grep simul|wc -l + # (ssh host echo simul-login & ssh host echo simul-login & ...) | + # grep simul|wc -l + # Input: + # $wanted_processes = Try for this many logins in parallel # Returns: - # Number of succesful logins + # $ssh_limit = Number of succesful parallel logins local $/ = "\n"; my $self = shift; my $wanted_processes = shift; @@ -6188,7 +6533,8 @@ sub simultaneous_sshlogin { my $serverlogin = $self->serverlogin(); my $sshdelay = $opt::sshdelay ? "sleep $opt::sshdelay;" : ""; # TODO sh -c wrapper to work for csh - my $cmd = "$sshdelay$sshcmd $serverlogin -- echo simultaneouslogin &1 &"x$wanted_processes; + my $cmd = ("$sshdelay$sshcmd $serverlogin -- ". + "echo simultaneouslogin &1 &")x$wanted_processes; ::debug("init", "Trying $wanted_processes logins at $serverlogin\n"); open (my $simul_fh, "-|", "($cmd)|grep simultaneouslogin | wc -l") or ::die_bug("simultaneouslogin"); @@ -6198,15 +6544,17 @@ sub simultaneous_sshlogin { return $ssh_limit; } -sub set_ncpus { +sub set_ncpus($$) { my $self = shift; $self->{'ncpus'} = shift; } -sub user_requested_processes { +sub user_requested_processes($) { # Parse the number of processes that the user asked for using -j + # Input: + # $opt_P = string formatted as for -P # Returns: - # the number of processes to run on this sshlogin + # $processes = the number of processes to run on this sshlogin my $self = shift; my $opt_P = shift; my $processes; @@ -6251,25 +6599,38 @@ sub user_requested_processes { return $processes; } -sub ncpus { +sub ncpus($) { + # Number of CPU threads + # --use_sockets_instead_of_threads = count socket instead + # --use_cores_instead_of_threads = count physical cores instead + # Returns: + # $ncpus = number of cpu (threads) on this sshlogin local $/ = "\n"; my $self = shift; if(not defined $self->{'ncpus'}) { my $sshcmd = $self->sshcommand(); my $serverlogin = $self->serverlogin(); if($serverlogin eq ":") { - if($opt::use_cpus_instead_of_cores) { - $self->{'ncpus'} = no_of_cpus(); + if($opt::use_sockets_instead_of_threads) { + $self->{'ncpus'} = socket_core_thread()->{'sockets'}; + } elsif($opt::use_cores_instead_of_threads) { + $self->{'ncpus'} = socket_core_thread()->{'cores'}; } else { - $self->{'ncpus'} = no_of_cores(); + $self->{'ncpus'} = socket_core_thread()->{'threads'}; } } else { my $ncpu; - if($opt::use_cpus_instead_of_cores) { - $ncpu = ::qqx("echo|$sshcmd $serverlogin -- parallel --number-of-cpus"); + if($opt::use_sockets_instead_of_threads + or + $opt::use_cpus_instead_of_cores) { + $ncpu = + ::qqx("echo|$sshcmd $serverlogin -- parallel --number-of-sockets"); + } elsif($opt::use_cores_instead_of_threads) { + $ncpu = + ::qqx("echo|$sshcmd $serverlogin -- parallel --number-of-cores"); } else { - ::debug("init",qq(echo|$sshcmd $serverlogin -- parallel --number-of-cores\n)); - $ncpu = ::qqx("echo|$sshcmd $serverlogin -- parallel --number-of-cores"); + $ncpu = + ::qqx("echo|$sshcmd $serverlogin -- parallel --number-of-threads"); } chomp $ncpu; if($ncpu =~ /^\s*[0-9]+\s*$/s) { @@ -6284,475 +6645,487 @@ sub ncpus { return $self->{'ncpus'}; } -sub no_of_cpus { + +sub nproc() { # Returns: - # Number of physical CPUs - local $/ = "\n"; # If delimiter is set, then $/ will be wrong - my $no_of_cpus; + # Number of threads using `nproc` + my $no_of_threads = ::qqx("nproc"); + chomp $no_of_threads; + return $no_of_threads; +} + +sub no_of_sockets() { + return socket_core_thread()->{'sockets'}; +} + +sub no_of_cores() { + return socket_core_thread()->{'cores'}; +} + +sub no_of_threads() { + return socket_core_thread()->{'threads'}; +} + +sub socket_core_thread() { + # Returns: + # { + # 'sockets' => #sockets = number of socket with CPU present + # 'cores' => #cores = number of physical cores + # 'threads' => #threads = number of compute cores (hyperthreading) + # 'active' => #taskset_threads = number of taskset limited cores + # } + my $cpu; + if ($^O eq 'linux') { - $no_of_cpus = no_of_cpus_gnu_linux() || no_of_cores_gnu_linux(); + $cpu = sct_gnu_linux(); + } elsif ($^O eq 'android') { + $cpu = sct_android(); } elsif ($^O eq 'freebsd') { - $no_of_cpus = no_of_cpus_freebsd(); + $cpu = sct_freebsd(); } elsif ($^O eq 'netbsd') { - $no_of_cpus = no_of_cpus_netbsd(); + $cpu = sct_netbsd(); } elsif ($^O eq 'openbsd') { - $no_of_cpus = no_of_cpus_openbsd(); + $cpu = sct_openbsd(); } elsif ($^O eq 'gnu') { - $no_of_cpus = no_of_cpus_hurd(); + $cpu = sct_hurd(); } elsif ($^O eq 'darwin') { - $no_of_cpus = no_of_cpus_darwin(); + $cpu = sct_darwin(); } elsif ($^O eq 'solaris') { - $no_of_cpus = no_of_cpus_solaris() || nproc(); + $cpu = sct_solaris(); } elsif ($^O eq 'aix') { - $no_of_cpus = no_of_cpus_aix(); + $cpu = sct_aix(); } elsif ($^O eq 'hpux') { - $no_of_cpus = no_of_cpus_hpux(); + $cpu = sct_hpux(); } elsif ($^O eq 'nto') { - $no_of_cpus = no_of_cpus_qnx(); + $cpu = sct_qnx(); } elsif ($^O eq 'svr5') { - $no_of_cpus = no_of_cpus_openserver(); + $cpu = sct_openserver(); } elsif ($^O eq 'irix') { - $no_of_cpus = no_of_cpus_irix(); + $cpu = sct_irix(); } elsif ($^O eq 'dec_osf') { - $no_of_cpus = no_of_cpus_tru64(); + $cpu = sct_tru64(); } else { - $no_of_cpus = (no_of_cpus_gnu_linux() - || no_of_cpus_freebsd() - || no_of_cpus_netbsd() - || no_of_cpus_openbsd() - || no_of_cpus_hurd() - || no_of_cpus_darwin() - || no_of_cpus_solaris() - || no_of_cpus_aix() - || no_of_cpus_hpux() - || no_of_cpus_qnx() - || no_of_cpus_openserver() - || no_of_cpus_irix() - || no_of_cpus_tru64() - # Number of cores is better than no guess for #CPUs - || nproc() + # Try all methods until we find something that works + $cpu = (sct_gnu_linux() + || sct_android() + || sct_freebsd() + || sct_netbsd() + || sct_openbsd() + || sct_hurd() + || sct_darwin() + || sct_solaris() + || sct_aix() + || sct_hpux() + || sct_qnx() + || sct_openserver() + || sct_irix() + || sct_tru64() ); } - if($no_of_cpus) { - chomp $no_of_cpus; - return $no_of_cpus; - } else { - ::warning("Cannot figure out number of cpus. Using 1."); - return 1; - } -} - -sub no_of_cores { - # Returns: - # Number of CPU cores - local $/ = "\n"; # If delimiter is set, then $/ will be wrong - my $no_of_cores; - if ($^O eq 'linux') { - $no_of_cores = no_of_cores_gnu_linux(); - } elsif ($^O eq 'freebsd') { - $no_of_cores = no_of_cores_freebsd(); - } elsif ($^O eq 'netbsd') { - $no_of_cores = no_of_cores_netbsd(); - } elsif ($^O eq 'openbsd') { - $no_of_cores = no_of_cores_openbsd(); - } elsif ($^O eq 'gnu') { - $no_of_cores = no_of_cores_hurd(); - } elsif ($^O eq 'darwin') { - $no_of_cores = no_of_cores_darwin(); - } elsif ($^O eq 'solaris') { - $no_of_cores = no_of_cores_solaris() || nproc(); - } elsif ($^O eq 'aix') { - $no_of_cores = no_of_cores_aix(); - } elsif ($^O eq 'hpux') { - $no_of_cores = no_of_cores_hpux(); - } elsif ($^O eq 'nto') { - $no_of_cores = no_of_cores_qnx(); - } elsif ($^O eq 'svr5') { - $no_of_cores = no_of_cores_openserver(); - } elsif ($^O eq 'irix') { - $no_of_cores = no_of_cores_irix(); - } elsif ($^O eq 'dec_osf') { - $no_of_cores = no_of_cores_tru64(); - } else { - $no_of_cores = (no_of_cores_gnu_linux() - || no_of_cores_freebsd() - || no_of_cores_netbsd() - || no_of_cores_openbsd() - || no_of_cores_hurd() - || no_of_cores_darwin() - || no_of_cores_solaris() - || no_of_cores_aix() - || no_of_cores_hpux() - || no_of_cores_qnx() - || no_of_cores_openserver() - || no_of_cores_irix() - || no_of_cores_tru64() - || nproc() - ); - } - if($no_of_cores) { - chomp $no_of_cores; - return $no_of_cores; - } else { - ::warning("Cannot figure out number of CPU cores. Using 1."); - return 1; - } -} - -sub nproc { - # Returns: - # Number of cores using `nproc` - my $no_of_cores = ::qqx("nproc"); - return $no_of_cores; -} - -sub no_of_cpus_gnu_linux { - # Returns: - # Number of physical CPUs on GNU/Linux - # undef if not GNU/Linux - my $no_of_cpus; - my $no_of_cores; - my $no_of_active_cores; - if(-e "/proc/cpuinfo") { - $no_of_cpus = 0; - $no_of_cores = 0; - my %seen; - if(open(my $in_fh, "<", "/proc/cpuinfo")) { - while(<$in_fh>) { - if(/^physical id.*[:](.*)/ and not $seen{$1}++) { - $no_of_cpus++; - } - /^processor.*[:]/i and $no_of_cores++; - } - close $in_fh; + if(not $cpu) { + my $nproc = nproc(); + if($nproc) { + $cpu->{'sockets'} = + $cpu->{'cores'} = + $cpu->{'threads'} = + $cpu->{'active'} = + $nproc; } } - if(-e "/proc/self/status") { - # if 'taskset' is used to limit number of cores - if(open(my $in_fh, "<", "/proc/self/status")) { + if(not $cpu) { + ::warning("Cannot figure out number of cpus. Using 1."); + $cpu->{'sockets'} = + $cpu->{'cores'} = + $cpu->{'threads'} = + $cpu->{'active'} = + 1 + } + + # Choose minimum of active and actual + my $mincpu; + $mincpu->{'sockets'} = ::min($cpu->{'sockets'},$cpu->{'active'}); + $mincpu->{'cores'} = ::min($cpu->{'cores'},$cpu->{'active'}); + $mincpu->{'threads'} = ::min($cpu->{'threads'},$cpu->{'active'}); + return $mincpu; +} + +sub sct_gnu_linux() { + # Returns: + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } + my $cpu; + local $/ = "\n"; # If delimiter is set, then $/ will be wrong + if($ENV{'PARALLEL_CPUINFO'} or -e "/proc/cpuinfo") { + $cpu->{'sockets'} = 0; + $cpu->{'cores'} = 0; + $cpu->{'threads'} = 0; + my %seen; + my %phy_seen; + my @cpuinfo; + my $physicalid; + if(open(my $in_fh, "<", "/proc/cpuinfo")) { + @cpuinfo = <$in_fh>; + close $in_fh; + } + if($ENV{'PARALLEL_CPUINFO'}) { + # Use CPUINFO from environment - used for testing only + @cpuinfo = split/(?<=\n)/,$ENV{'PARALLEL_CPUINFO'}; + } + for(@cpuinfo) { + if(/^physical id.*[:](.*)/) { + $physicalid=$1; + if(not $phy_seen{$1}++) { + $cpu->{'sockets'}++; + } + } + if(/^core id.*[:](.*)/ and not $seen{$physicalid,$1}++) { + $cpu->{'cores'}++; + } + /^processor.*[:]/i and $cpu->{'threads'}++; + } + $cpu->{'sockets'} ||= 1; + $cpu->{'cores'} ||= $cpu->{'threads'}; + } + if(-e "/proc/self/status" and not $ENV{'PARALLEL_CPUINFO'}) { + # if 'taskset' is used to limit number of threads + if(open(my $in_fh, "<", "/proc/self/status")) { while(<$in_fh>) { if(/^Cpus_allowed:\s*(\S+)/) { my $a = $1; $a =~ tr/,//d; - $no_of_active_cores = unpack ("%32b*", pack ("H*",$a)); + $cpu->{'active'} = unpack ("%32b*", pack ("H*",$a)); } } close $in_fh; } } - return (::min($no_of_cpus || $no_of_cores,$no_of_active_cores)); + if(grep { /\d/ } values %$cpu) { + return $cpu; + } else { + return undef; + } } -sub no_of_cores_gnu_linux { +sub sct_android() { # Returns: - # Number of CPU cores on GNU/Linux - # undef if not GNU/Linux - my $no_of_cores; - my $no_of_active_cores; - if(-e "/proc/cpuinfo") { - $no_of_cores = 0; - open(my $in_fh, "<", "/proc/cpuinfo") || return undef; - while(<$in_fh>) { - /^processor.*[:]/i and $no_of_cores++; - } - close $in_fh; - } - if(-e "/proc/self/status") { - # if 'taskset' is used to limit number of cores - if(open(my $in_fh, "<", "/proc/self/status")) { - while(<$in_fh>) { - if(/^Cpus_allowed:\s*(\S+)/) { - my $a = $1; - $a =~ tr/,//d; - $no_of_active_cores = unpack ("%32b*", pack ("H*",$a)); - } - } - close $in_fh; - } - } - return (::min($no_of_cores,$no_of_active_cores)); + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } + # Use GNU/Linux + return sct_gnu_linux(); } -sub no_of_cpus_freebsd { +sub sct_freebsd() { # Returns: - # Number of physical CPUs on FreeBSD - # undef if not FreeBSD + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } local $/ = "\n"; - my $no_of_cpus = - (::qqx(qq{ sysctl -a dev.cpu | grep \%parent | awk '{ print \$2 }' | uniq | wc -l | awk '{ print \$1 }' }) + my $cpu; + $cpu->{'cores'} = (::qqx(qq{ sysctl -a dev.cpu | grep \%parent | awk '{ print \$2 }' | uniq | wc -l | awk '{ print \$1 }' }) or ::qqx(qq{ sysctl hw.ncpu | awk '{ print \$2 }' })); - chomp $no_of_cpus; - return $no_of_cpus; -} - -sub no_of_cores_freebsd { - # Returns: - # Number of CPU cores on FreeBSD - # undef if not FreeBSD - local $/ = "\n"; - my $no_of_cores = + $cpu->{'cores'} and chomp $cpu->{'cores'}; + $cpu->{'threads'} = (::qqx(qq{ sysctl hw.ncpu | awk '{ print \$2 }' }) or ::qqx(qq{ sysctl -a dev.cpu | grep \%parent | awk '{ print \$2 }' | uniq | wc -l | awk '{ print \$1 }' })); - chomp $no_of_cores; - return $no_of_cores; + $cpu->{'threads'} and chomp $cpu->{'threads'}; + $cpu->{'sockets'} ||= $cpu->{'cores'}; + + if(grep { /\d/ } values %$cpu) { + return $cpu; + } else { + return undef; + } } -sub no_of_cpus_netbsd { +sub sct_netbsd() { # Returns: - # Number of physical CPUs on NetBSD - # undef if not NetBSD + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } local $/ = "\n"; - my $no_of_cpus = ::qqx("sysctl -n hw.ncpu"); - chomp $no_of_cpus; - return $no_of_cpus; + my $cpu; + $cpu->{'cores'} = ::qqx("sysctl -n hw.ncpu"); + $cpu->{'cores'} and chomp $cpu->{'cores'}; + $cpu->{'threads'} = ::qqx("sysctl -n hw.ncpu"); + $cpu->{'threads'} and chomp $cpu->{'threads'}; + $cpu->{'sockets'} ||= $cpu->{'cores'}; + + if(grep { /\d/ } values %$cpu) { + return $cpu; + } else { + return undef; + } } -sub no_of_cores_netbsd { +sub sct_openbsd() { # Returns: - # Number of CPU cores on NetBSD - # undef if not NetBSD + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } local $/ = "\n"; - my $no_of_cores = ::qqx("sysctl -n hw.ncpu"); - chomp $no_of_cores; - return $no_of_cores; + my $cpu; + $cpu->{'cores'} = ::qqx('sysctl -n hw.ncpu'); + $cpu->{'cores'} and chomp $cpu->{'cores'}; + $cpu->{'threads'} = ::qqx('sysctl -n hw.ncpu'); + $cpu->{'threads'} and chomp $cpu->{'threads'}; + $cpu->{'sockets'} ||= $cpu->{'cores'}; + + if(grep { /\d/ } values %$cpu) { + return $cpu; + } else { + return undef; + } } -sub no_of_cpus_openbsd { +sub sct_hurd() { # Returns: - # Number of physical CPUs on OpenBSD - # undef if not OpenBSD + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } local $/ = "\n"; - my $no_of_cpus = ::qqx('sysctl -n hw.ncpu'); - chomp $no_of_cpus; - return $no_of_cpus; + my $cpu; + $cpu->{'cores'} = ::qqx("nproc"); + $cpu->{'cores'} and chomp $cpu->{'cores'}; + $cpu->{'threads'} = ::qqx("nproc"); + $cpu->{'threads'} and chomp $cpu->{'threads'}; + + if(grep { /\d/ } values %$cpu) { + return $cpu; + } else { + return undef; + } } -sub no_of_cores_openbsd { +sub sct_darwin() { # Returns: - # Number of CPU cores on OpenBSD - # undef if not OpenBSD + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } local $/ = "\n"; - my $no_of_cores = ::qqx('sysctl -n hw.ncpu'); - chomp $no_of_cores; - return $no_of_cores; -} - -sub no_of_cpus_hurd { - # Returns: - # Number of physical CPUs on HURD - # undef if not HURD - local $/ = "\n"; - my $no_of_cpus = ::qqx("nproc"); - chomp $no_of_cpus; - return $no_of_cpus; -} - -sub no_of_cores_hurd { - # Returns: - # Number of physical CPUs on HURD - # undef if not HURD - local $/ = "\n"; - my $no_of_cores = ::qqx("nproc"); - chomp $no_of_cores; - return $no_of_cores; -} - -sub no_of_cpus_darwin { - # Returns: - # Number of physical CPUs on MacOSX Darwin - # undef if not MacOSX Darwin - my $no_of_cpus = + my $cpu; + $cpu->{'cores'} = (::qqx('sysctl -n hw.physicalcpu') or ::qqx(qq{ sysctl -a hw | grep [^a-z]physicalcpu[^a-z] | awk '{ print \$2 }' })); - return $no_of_cpus; -} - -sub no_of_cores_darwin { - # Returns: - # Number of CPU cores on Mac Darwin - # undef if not Mac Darwin - my $no_of_cores = + $cpu->{'cores'} and chomp $cpu->{'cores'}; + $cpu->{'threads'} = (::qqx('sysctl -n hw.logicalcpu') or ::qqx(qq{ sysctl -a hw | grep [^a-z]logicalcpu[^a-z] | awk '{ print \$2 }' })); - return $no_of_cores; + $cpu->{'threads'} and chomp $cpu->{'threads'}; + $cpu->{'sockets'} ||= $cpu->{'cores'}; + + if(grep { /\d/ } values %$cpu) { + return $cpu; + } else { + return undef; + } } -sub no_of_cpus_solaris { +sub sct_solaris() { # Returns: - # Number of physical CPUs on Solaris - # undef if not Solaris - if(-x "/usr/sbin/psrinfo") { - my @psrinfo = ::qqx("/usr/sbin/psrinfo"); - if($#psrinfo >= 0) { - return $#psrinfo +1; - } - } - if(-x "/usr/sbin/prtconf") { - my @prtconf = ::qqx("/usr/sbin/prtconf | grep cpu..instance"); - if($#prtconf >= 0) { - return $#prtconf +1; - } - } - if(-x "/usr/sbin/prtconf") { - my @prtconf = ::qqx("/usr/sbin/prtconf | grep cpu..instance"); - if($#prtconf >= 0) { - return $#prtconf +1; - } - } - return undef; -} - -sub no_of_cores_solaris { - # Returns: - # Number of CPU cores on Solaris - # undef if not Solaris - if(-x "/usr/sbin/psrinfo") { - my @psrinfo = ::qqx("/usr/sbin/psrinfo"); - if($#psrinfo >= 0) { - return $#psrinfo +1; - } - } - if(-x "/usr/sbin/prtconf") { - my @prtconf = ::qqx("/usr/sbin/prtconf | grep cpu..instance"); - if($#prtconf >= 0) { - return $#prtconf +1; - } - } - return undef; -} - -sub no_of_cpus_aix { - # Returns: - # Number of physical CPUs on AIX - # undef if not AIX + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } local $/ = "\n"; - my $no_of_cpus = 0; + my $cpu; + if(-x "/usr/sbin/psrinfo") { + my @psrinfo = ::qqx("/usr/sbin/psrinfo"); + if($#psrinfo >= 0) { + $cpu->{'cores'} = $#psrinfo +1; + } + } + if(-x "/usr/sbin/prtconf") { + my @prtconf = ::qqx("/usr/sbin/prtconf | grep cpu..instance"); + if($#prtconf >= 0) { + $cpu->{'cores'} = $#prtconf +1; + } + } + if(-x "/usr/sbin/prtconf") { + my @prtconf = ::qqx("/usr/sbin/prtconf | grep cpu..instance"); + if($#prtconf >= 0) { + $cpu->{'cores'} = $#prtconf +1; + } + } + $cpu->{'cores'} and chomp $cpu->{'cores'}; + + if(-x "/usr/sbin/psrinfo") { + my @psrinfo = ::qqx("/usr/sbin/psrinfo"); + if($#psrinfo >= 0) { + $cpu->{'threads'} = $#psrinfo +1; + } + } + if(-x "/usr/sbin/prtconf") { + my @prtconf = ::qqx("/usr/sbin/prtconf | grep cpu..instance"); + if($#prtconf >= 0) { + $cpu->{'threads'} = $#prtconf +1; + } + } + $cpu->{'threads'} and chomp $cpu->{'threads'}; + + if(grep { /\d/ } values %$cpu) { + return $cpu; + } else { + return undef; + } +} + +sub sct_aix() { + # Returns: + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } + local $/ = "\n"; + my $cpu; if(-x "/usr/sbin/lscfg") { - open(my $in_fh, "-|", "/usr/sbin/lscfg -vs |grep proc | wc -l|tr -d ' '") - || return undef; - $no_of_cpus = <$in_fh>; - chomp ($no_of_cpus); - close $in_fh; - } - return $no_of_cpus; -} - -sub no_of_cores_aix { - # Returns: - # Number of CPU cores on AIX - # undef if not AIX - my $no_of_cores; - if(-x "/usr/bin/vmstat") { - open(my $in_fh, "-|", "/usr/bin/vmstat 1 1") || return undef; - while(<$in_fh>) { - /lcpu=([0-9]*) / and $no_of_cores = $1; + if(open(my $in_fh, "-|", "/usr/sbin/lscfg -vs |grep proc | wc -l|tr -d ' '")) { + $cpu->{'cores'} = <$in_fh>; + chomp ($cpu->{'cores'}); + close $in_fh; } - close $in_fh; } - return $no_of_cores; + if(-x "/usr/bin/vmstat") { + if(open(my $in_fh, "-|", "/usr/bin/vmstat 1 1")) { + while(<$in_fh>) { + /lcpu=([0-9]*) / and $cpu->{'threads'} = $1; + } + close $in_fh; + } + } + + if(grep { /\d/ } values %$cpu) { + # BUG It is not not known how to calculate this + $cpu->{'sockets'} = 1; + return $cpu; + } else { + return undef; + } } -sub no_of_cpus_hpux { +sub sct_hpux() { # Returns: - # Number of physical CPUs on HP-UX - # undef if not HP-UX - my $no_of_cpus = + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } + local $/ = "\n"; + my $cpu; + $cpu->{'cores'} = ::qqx(qq{ /usr/bin/mpsched -s 2>&1 | grep 'Locality Domain Count' | awk '{ print \$4 }'}); - return $no_of_cpus; + chomp($cpu->{'cores'}); + $cpu->{'threads'} = + ::qqx(qq{ /usr/bin/mpsched -s 2>&1 | perl -ne '/Processor Count\\D+(\\d+)/ and print "\$1"'}); + + if(grep { /\d/ } values %$cpu) { + # BUG It is not not known how to calculate this + $cpu->{'sockets'} = 1; + return $cpu; + } else { + return undef; + } } -sub no_of_cores_hpux { +sub sct_qnx() { # Returns: - # Number of CPU cores on HP-UX - # undef if not HP-UX - my $no_of_cores = - ::qqx(qq{ /usr/bin/mpsched -s 2>&1 | perl -ne '/Processor Count\\D+(\\d+)/ and print "\$1\n"'}); - return $no_of_cores; -} - -sub no_of_cpus_qnx { - # Returns: - # Number of physical CPUs on QNX - # undef if not QNX + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } + local $/ = "\n"; + my $cpu; # BUG: It is not known how to calculate this. - my $no_of_cpus = 0; - return $no_of_cpus; + + if(grep { /\d/ } values %$cpu) { + return $cpu; + } else { + return undef; + } } -sub no_of_cores_qnx { +sub sct_openserver() { # Returns: - # Number of CPU cores on QNX - # undef if not QNX - # BUG: It is not known how to calculate this. - my $no_of_cores = 0; - return $no_of_cores; -} - -sub no_of_cpus_openserver { - # Returns: - # Number of physical CPUs on SCO OpenServer - # undef if not SCO OpenServer - my $no_of_cpus = 0; + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } + local $/ = "\n"; + my $cpu; if(-x "/usr/sbin/psrinfo") { my @psrinfo = ::qqx("/usr/sbin/psrinfo"); if($#psrinfo >= 0) { - return $#psrinfo +1; + $cpu->{'cores'} = $#psrinfo +1; } } - return $no_of_cpus; -} - -sub no_of_cores_openserver { - # Returns: - # Number of CPU cores on SCO OpenServer - # undef if not SCO OpenServer - my $no_of_cores = 0; if(-x "/usr/sbin/psrinfo") { my @psrinfo = ::qqx("/usr/sbin/psrinfo"); if($#psrinfo >= 0) { - return $#psrinfo +1; + $cpu->{'threads'} = $#psrinfo +1; } } - return $no_of_cores; + $cpu->{'sockets'} ||= $cpu->{'cores'}; + + if(grep { /\d/ } values %$cpu) { + return $cpu; + } else { + return undef; + } } -sub no_of_cpus_irix { +sub sct_irix() { # Returns: - # Number of physical CPUs on IRIX - # undef if not IRIX - my $no_of_cpus = ::qqx(qq{ hinv | grep HZ | grep Processor | awk '{print \$1}' }); - return $no_of_cpus; + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } + local $/ = "\n"; + my $cpu; + $cpu->{'cores'} = ::qqx(qq{ hinv | grep HZ | grep Processor | awk '{print \$1}' }); + $cpu->{'cores'} and chomp $cpu->{'cores'}; + + if(grep { /\d/ } values %$cpu) { + return $cpu; + } else { + return undef; + } } -sub no_of_cores_irix { +sub sct_tru64() { # Returns: - # Number of CPU cores on IRIX - # undef if not IRIX - my $no_of_cores = ::qqx(qq{ hinv | grep HZ | grep Processor | awk '{print \$1}' }); - return $no_of_cores; + # { 'sockets' => #sockets + # 'cores' => #cores + # 'threads' => #threads + # 'active' => #taskset_threads } + local $/ = "\n"; + my $cpu; + $cpu->{'cores'} = ::qqx("sizer -pr"); + $cpu->{'cores'} and chomp $cpu->{'cores'}; + $cpu->{'cores'} ||= 1; + $cpu->{'sockets'} ||= $cpu->{'cores'}; + $cpu->{'threads'} ||= $cpu->{'cores'}; + + if(grep { /\d/ } values %$cpu) { + return $cpu; + } else { + return undef; + } } -sub no_of_cpus_tru64 { +sub sshcommand($) { # Returns: - # Number of physical CPUs on Tru64 - # undef if not Tru64 - my $no_of_cpus = ::qqx("sizer -pr"); - return $no_of_cpus; -} - -sub no_of_cores_tru64 { - # Returns: - # Number of CPU cores on Tru64 - # undef if not Tru64 - my $no_of_cores = ::qqx("sizer -pr"); - return $no_of_cores; -} - -sub sshcommand { + # $sshcommand = the command (incl options) to run when using ssh my $self = shift; if (not defined $self->{'sshcommand'}) { $self->sshcommand_of_sshlogin(); @@ -6760,7 +7133,9 @@ sub sshcommand { return $self->{'sshcommand'}; } -sub serverlogin { +sub serverlogin($) { + # Returns: + # $sshcommand = the command (incl options) to run when using ssh my $self = shift; if (not defined $self->{'serverlogin'}) { $self->sshcommand_of_sshlogin(); @@ -6768,15 +7143,16 @@ sub serverlogin { return $self->{'serverlogin'}; } -sub sshcommand_of_sshlogin { +sub sshcommand_of_sshlogin($) { + # Compute ssh command and serverlogin from sshlogin # 'server' -> ('ssh -S /tmp/parallel-ssh-RANDOM/host-','server') # 'user@server' -> ('ssh','user@server') # 'myssh user@server' -> ('myssh','user@server') # 'myssh -l user server' -> ('myssh -l user','server') # '/usr/bin/myssh -l user server' -> ('/usr/bin/myssh -l user','server') - # Returns: - # sshcommand - defaults to 'ssh' - # login@host + # Sets: + # $self->{'sshcommand'} + # $self->{'serverlogin'} my $self = shift; my ($sshcmd, $serverlogin); # If $opt::ssh is unset, use $PARALLEL_SSH or 'ssh' @@ -6806,8 +7182,7 @@ sub sshcommand_of_sshlogin { open(STDIN,"<","/dev/null"); # Run a sleep that outputs data, so it will discover # if the ssh connection closes. - my $sleep = ::shell_quote_scalar - ('$|=1;while(1){sleep 1;print "foo\n"}'); + my $sleep = ::Q('$|=1;while(1){sleep 1;print "foo\n"}'); my @master = ($opt::ssh, "-MTS", $control_path, $serverlogin, "--", "perl", "-e", $sleep); @@ -6829,9 +7204,9 @@ sub sshcommand_of_sshlogin { $self->{'serverlogin'} = $serverlogin; } -sub control_path_dir { +sub control_path_dir($) { # Returns: - # path to directory + # $control_path_dir = dir of control path (for -M) my $self = shift; if(not defined $self->{'control_path_dir'}) { $self->{'control_path_dir'} = @@ -6844,7 +7219,7 @@ sub control_path_dir { return $self->{'control_path_dir'}; } -sub rsync_transfer_cmd { +sub rsync_transfer_cmd($) { # Command to run to transfer a file # Input: # $file = filename of file to transfer @@ -6869,14 +7244,14 @@ sub rsync_transfer_cmd { $file = ::shell_quote_file($file); my $sshcmd = $self->sshcommand(); my $rsync_opts = $ENV{'PARALLEL_RSYNC_OPTS'}. - " -e".::shell_quote_scalar($sshcmd); + " -e".::Q($sshcmd); my $serverlogin = $self->serverlogin(); # Make dir if it does not exist return "$sshcmd $serverlogin -- mkdir -p $rsync_destdir && " . rsync()." $rsync_opts $file $serverlogin:$rsync_destdir"; } -sub cleanup_cmd { +sub cleanup_cmd($$$) { # Command to run to remove the remote file # Input: # $file = filename to remove @@ -6902,15 +7277,15 @@ sub cleanup_cmd { $dir .= $_."/"; unshift @rmdir, ::shell_quote_file($dir); } - my $rmdir = @rmdir ? "sh -c ".::shell_quote_scalar("rmdir @rmdir 2>/dev/null;") : ""; + my $rmdir = @rmdir ? "sh -c ".::Q("rmdir @rmdir 2>/dev/null;") : ""; if(defined $opt::workdir and $opt::workdir eq "...") { - $rmdir .= ::shell_quote_scalar("rm -rf " . ::shell_quote_file($workdir).';'); + $rmdir .= ::Q("rm -rf " . ::shell_quote_file($workdir).';'); } $f = ::shell_quote_file($f); my $sshcmd = $self->sshcommand(); my $serverlogin = $self->serverlogin(); - return "$sshcmd $serverlogin -- ".::shell_quote_scalar("rm -f $f; $rmdir"); + return "$sshcmd $serverlogin -- ".::Q("rm -f $f; $rmdir"); } { @@ -6919,6 +7294,8 @@ sub cleanup_cmd { sub rsync { # rsync 3.1.x uses protocol 31 which is unsupported by 2.5.7. # If the version >= 3.1.0: downgrade to protocol 30 + # Returns: + # $rsync = "rsync" or "rsync --protocol 30" if(not $rsync) { my @out = `rsync --version`; for (@out) { @@ -6940,7 +7317,7 @@ sub cleanup_cmd { package JobQueue; -sub new { +sub new($) { my $class = shift; my $commandref = shift; my $read_from = shift; @@ -6960,7 +7337,7 @@ sub new { }, ref($class) || $class; } -sub get { +sub get($) { my $self = shift; $self->{'this_job_no'}++; @@ -6977,21 +7354,21 @@ sub get { } } -sub unget { +sub unget($) { my $self = shift; unshift @{$self->{'unget'}}, @_; $self->{'this_job_no'} -= @_; } -sub empty { +sub empty($) { my $self = shift; - my $empty = (not @{$self->{'unget'}}) - && $self->{'commandlinequeue'}->empty(); + my $empty = (not @{$self->{'unget'}}) && + $self->{'commandlinequeue'}->empty(); ::debug("run", "JobQueue->empty $empty "); return $empty; } -sub total_jobs { +sub total_jobs($) { my $self = shift; if(not defined $self->{'total_jobs'}) { if($opt::pipe and not $opt::tee) { @@ -7019,7 +7396,7 @@ sub total_jobs { while($record = $record_queue->get()) { push @arg_records, $record; } - if($opt::shuf) { + if($opt::shuf and @arg_records) { my $i = @arg_records; while (--$i) { my $j = int rand($i+1); @@ -7027,29 +7404,35 @@ sub total_jobs { } } $record_queue->unget(@arg_records); - $self->{'total_jobs'} = - ::ceil((1+$#arg_records+$self->{'this_job_no'}) - / ::max($Global::max_number_of_args,1)); + # $#arg_records = number of args - 1 + # We have read one @arg_record for this job (so add 1 more) + my $num_args = $#arg_records + 2; + # This jobs is not started so -1 + my $started_jobs = $self->{'this_job_no'} - 1; + my $max_args = ::max($Global::max_number_of_args,1); + $self->{'total_jobs'} = ::ceil($num_args / $max_args) + + $started_jobs; ::debug("init","Total jobs: ".$self->{'total_jobs'}. - " (".(1+$#arg_records)."+".$self->{'this_job_no'}.")\n"); + " ($num_args/$max_args + $started_jobs)\n"); } } return $self->{'total_jobs'}; } -sub flush_total_jobs { +sub flush_total_jobs($) { # Unset total_jobs to force recomputing my $self = shift; + ::debug("init","flush Total jobs: "); $self->{'total_jobs'} = undef; } -sub next_seq { +sub next_seq($) { my $self = shift; return $self->{'commandlinequeue'}->seq(); } -sub quote_args { +sub quote_args($) { my $self = shift; return $self->{'commandlinequeue'}->quote_args(); } @@ -7057,7 +7440,7 @@ sub quote_args { package Job; -sub new { +sub new($) { my $class = shift; my $commandlineref = shift; return bless { @@ -7088,28 +7471,28 @@ sub new { }, ref($class) || $class; } -sub replaced { +sub replaced($) { my $self = shift; $self->{'commandline'} or ::die_bug("commandline empty"); return $self->{'commandline'}->replaced(); } -sub seq { +sub seq($) { my $self = shift; return $self->{'commandline'}->seq(); } -sub set_seq { +sub set_seq($$) { my $self = shift; return $self->{'commandline'}->set_seq(shift); } -sub slot { +sub slot($) { my $self = shift; return $self->{'commandline'}->slot(); } -sub free_slot { +sub free_slot($) { my $self = shift; push @Global::slots, $self->slot(); } @@ -7117,7 +7500,7 @@ sub free_slot { { my($cattail); - sub cattail { + sub cattail() { # Returns: # $cattail = perl program for: # cattail "decompress program" writerpid [file_to_decompress or stdin] [file_to_unlink] @@ -7196,7 +7579,7 @@ sub free_slot { } } -sub openoutputfiles { +sub openoutputfiles($) { # Open files for STDOUT and STDERR # Set file handles in $self->fh my $self = shift; @@ -7307,7 +7690,7 @@ sub openoutputfiles { } } -sub print_verbose_dryrun { +sub print_verbose_dryrun($) { # If -v set: print command to stdout (possibly buffered) # This must be done before starting the command my $self = shift; @@ -7326,26 +7709,26 @@ sub print_verbose_dryrun { } } -sub add_rm { +sub add_rm($) { # Files to remove when job is done my $self = shift; push @{$self->{'unlink'}}, @_; } -sub get_rm { +sub get_rm($) { # Files to remove when job is done my $self = shift; return @{$self->{'unlink'}}; } -sub cleanup { +sub cleanup($) { # Remove files when job is done my $self = shift; unlink $self->get_rm(); delete @Global::unlink{$self->get_rm()}; } -sub grouped { +sub grouped($) { my $self = shift; # Set reading FD if using --group (--ungroup does not need) for my $fdno (1,2) { @@ -7355,12 +7738,12 @@ sub grouped { open(my $fdr,"<", $self->fh($fdno,'name')) || ::die_bug("fdr: Cannot open ".$self->fh($fdno,'name')); $self->set_fh($fdno,'r',$fdr); - # Unlink if required + # Unlink if not debugging $Global::debug or ::rm($self->fh($fdno,"unlink")); } } -sub empty_input_wrapper { +sub empty_input_wrapper($) { # If no input: exit(0) # If some input: Pass input as input to command on STDIN # This avoids starting the command if there is no input. @@ -7385,7 +7768,7 @@ sub empty_input_wrapper { exit ($?&127 ? 128+($?&127) : 1+$?>>8) } }); - ::debug("run",'Empty wrap: perl -e '.::shell_quote_scalar($script)."\n"); + ::debug("run",'Empty wrap: perl -e '.::Q($script)."\n"); if($Global::cshell and length $command > 499) { @@ -7393,16 +7776,16 @@ sub empty_input_wrapper { # $command = "perl -e '".base64_zip_eval()."' ". # join" ",string_zip_base64( # 'exec "'.::perl_quote_scalar($command).'"'); - return 'perl -e '.::shell_quote_scalar($script)." ". + return 'perl -e '.::Q($script)." ". base64_wrap("exec \"$Global::shell\",'-c',\"". ::perl_quote_scalar($command).'"'); } else { - return 'perl -e '.::shell_quote_scalar($script)." ". - $Global::shell." -c ".::shell_quote_scalar($command); + return 'perl -e '.::Q($script)." ". + $Global::shell." -c ".::Q($command); } } -sub filter_through_compress { +sub filter_through_compress($) { my $self = shift; # Send stdout to stdin for $opt::compress_program(1) # Send stderr to stdin for $opt::compress_program(2) @@ -7435,19 +7818,19 @@ sub filter_through_compress { -sub set_fh { +sub set_fh($$$$) { # Set file handle my ($self, $fd_no, $key, $fh) = @_; $self->{'fd'}{$fd_no,$key} = $fh; } -sub fh { +sub fh($) { # Get file handle my ($self, $fd_no, $key) = @_; return $self->{'fd'}{$fd_no,$key}; } -sub write { +sub write($) { my $self = shift; my $remaining_ref = shift; my $stdin_fh = $self->fh(0,"w"); @@ -7465,7 +7848,7 @@ sub write { } } -sub set_block { +sub set_block($$$$$$) { # Copy stdin buffer from $block_ref up to $endpos # Prepend with $header_ref if virgin (i.e. not --roundrobin) # Remove $recstart and $recend if needed @@ -7489,18 +7872,18 @@ sub set_block { $self->add_transfersize($self->{'block_length'}); } -sub block_ref { +sub block_ref($) { my $self = shift; return \$self->{'block'}; } -sub block_length { +sub block_length($) { my $self = shift; return $self->{'block_length'}; } -sub remove_rec_sep { +sub remove_rec_sep($) { my ($block_ref,$recstart,$recend) = @_; # Remove record separator $$block_ref =~ s/$recend$recstart//gos; @@ -7508,7 +7891,7 @@ sub remove_rec_sep { $$block_ref =~ s/$recend$//os; } -sub non_blocking_write { +sub non_blocking_write($) { my $self = shift; my $something_written = 0; use POSIX qw(:errno_h); @@ -7538,34 +7921,34 @@ sub non_blocking_write { } -sub virgin { +sub virgin($) { my $self = shift; return $self->{'virgin'}; } -sub set_virgin { +sub set_virgin($$) { my $self = shift; $self->{'virgin'} = shift; } -sub pid { +sub pid($) { my $self = shift; return $self->{'pid'}; } -sub set_pid { +sub set_pid($$) { my $self = shift; $self->{'pid'} = shift; } -sub starttime { +sub starttime($) { # Returns: # UNIX-timestamp this job started my $self = shift; return sprintf("%.3f",$self->{'starttime'}); } -sub set_starttime { +sub set_starttime($@) { my $self = shift; my $starttime = shift || ::now(); $self->{'starttime'} = $starttime; @@ -7574,7 +7957,7 @@ sub set_starttime { $starttime); } -sub runtime { +sub runtime($) { # Returns: # Run time in seconds with 3 decimals my $self = shift; @@ -7582,7 +7965,7 @@ sub runtime { int(($self->endtime() - $self->starttime())*1000)/1000); } -sub endtime { +sub endtime($) { # Returns: # UNIX-timestamp this job ended # 0 if not ended yet @@ -7590,7 +7973,7 @@ sub endtime { return ($self->{'endtime'} || 0); } -sub set_endtime { +sub set_endtime($$) { my $self = shift; my $endtime = shift; $self->{'endtime'} = $endtime; @@ -7599,7 +7982,7 @@ sub set_endtime { $self->runtime()); } -sub is_timedout { +sub is_timedout($) { # Is the job timedout? # Input: # $delta_time = time that the job may run @@ -7610,13 +7993,13 @@ sub is_timedout { return time > $self->{'starttime'} + $delta_time; } -sub kill { +sub kill($) { my $self = shift; $self->set_exitstatus(-1); ::kill_sleep_seq($self->pid()); } -sub failed { +sub failed($) { # return number of times failed for this $sshlogin # Input: # $sshlogin @@ -7627,7 +8010,7 @@ sub failed { return $self->{'failed'}{$sshlogin}; } -sub failed_here { +sub failed_here($) { # return number of times failed for the current $sshlogin # Returns: # Number of times failed for this sshlogin @@ -7635,33 +8018,33 @@ sub failed_here { return $self->{'failed'}{$self->sshlogin()}; } -sub add_failed { +sub add_failed($) { # increase the number of times failed for this $sshlogin my $self = shift; my $sshlogin = shift; $self->{'failed'}{$sshlogin}++; } -sub add_failed_here { +sub add_failed_here($) { # increase the number of times failed for the current $sshlogin my $self = shift; $self->{'failed'}{$self->sshlogin()}++; } -sub reset_failed { +sub reset_failed($) { # increase the number of times failed for this $sshlogin my $self = shift; my $sshlogin = shift; delete $self->{'failed'}{$sshlogin}; } -sub reset_failed_here { +sub reset_failed_here($) { # increase the number of times failed for this $sshlogin my $self = shift; delete $self->{'failed'}{$self->sshlogin()}; } -sub min_failed { +sub min_failed($) { # Returns: # the number of sshlogins this command has failed on # the minimal number of times this command has failed @@ -7672,7 +8055,7 @@ sub min_failed { return ($number_of_sshlogins_failed_on,$min_failures); } -sub total_failed { +sub total_failed($) { # Returns: # $total_failures = the number of times this command has failed my $self = shift; @@ -7712,7 +8095,7 @@ sub total_failed { { my $script; - sub fifo_wrap { + sub fifo_wrap() { # Script to create a fifo, run a command on the fifo # while copying STDIN to the fifo, and finally # remove the fifo and return the exit code of the command. @@ -7749,7 +8132,7 @@ sub total_failed { } } -sub wrapped { +sub wrapped($) { # Wrap command with: # * --shellquote # * --nice @@ -7764,7 +8147,7 @@ sub wrapped { # * --nice/--cat/--fifo should be done on the remote machine # * --pipepart/--pipe should be done on the local machine inside --tmux # Uses: - # $opt::shellquote + # @opt::shellquote # $opt::nice # $Global::shell # $opt::cat @@ -7781,31 +8164,26 @@ sub wrapped { # This will force them to run correctly, but will fail in # tcsh so we do not do it. # $command .= "\n\n"; - if($opt::shellquote) { - # Prepend /bin/echo (echo no-/bin is wrong in csh) - # and quote twice - $command = "/bin/echo " . - ::shell_quote_scalar(::shell_quote_scalar($command)); - } - if($ENV{'PARALLEL_ENV'}) { - if(-e $ENV{'PARALLEL_ENV'}) { - # This is a file/fifo: Replace envvar with content of file - open(my $parallel_env, "<", $ENV{'PARALLEL_ENV'}) || - ::die_bug("Cannot read parallel_env from $ENV{'PARALLEL_ENV'}"); - local $/; - $ENV{'PARALLEL_ENV'} = <$parallel_env>; - close $parallel_env; + if(@opt::shellquote) { + # Quote one time for each --shellquote + my $c = $command; + for(@opt::shellquote) { + $c = ::Q($c); } + # Prepend "echo" (it is written in perl because + # quoting '-e' causes problem in some versions and + # csh's version does something wrong) + $command = q(perl -e '$,=" "; print "@ARGV\n";' -- ) . ::Q($c); + } + if($Global::parallel_env) { # If $PARALLEL_ENV set, put that in front of the command # Used for env_parallel.* - # Map \001 to \n to make it easer to quote \n in $PARALLEL_ENV - $ENV{'PARALLEL_ENV'} =~ s/\001/\n/g; if($Global::shell =~ /zsh/) { # The extra 'eval' will make aliases work, too - $command = $ENV{'PARALLEL_ENV'}."\n". - "eval ".::shell_quote_scalar($command); + $command = $Global::parallel_env."\n". + "eval ".::Q($command); } else { - $command = $ENV{'PARALLEL_ENV'}."\n".$command; + $command = $Global::parallel_env."\n".$command; } } if($opt::cat) { @@ -7820,7 +8198,7 @@ sub wrapped { $command = 'cat > $PARALLEL_TMP;'. $command.";". postpone_exit_and_cleanup(). - '$PARALLEL_TMP'; + '$PARALLEL_TMP'; } elsif($opt::fifo) { # Prepend fifo-wrapper. In essence: # mkfifo {} @@ -7830,10 +8208,7 @@ sub wrapped { # wait; rm {} # without affecting $? $command = fifo_wrap(). " ". - $Global::shell. " ". - ::shell_quote_scalar($command). - ' $PARALLEL_TMP'. - ';'; + $Global::shell. " ". ::Q($command). ' $PARALLEL_TMP'. ';'; } # Wrap with ssh + tranferring of files $command = $self->sshlogin_wrap($command); @@ -7851,9 +8226,12 @@ sub wrapped { # # --pipe --tee: wrap: # (rm fifo; ... ) < fifo + # + # --pipe --shard X: + # (rm fifo; ... ) < fifo $command = (shift @Global::cat_prepends). "($command)". (shift @Global::cat_appends); - } elsif($opt::pipe) { + } elsif($opt::pipe and not $opt::roundrobin) { # Wrap with EOF-detector to avoid starting $command if EOF. $command = empty_input_wrapper($command); } @@ -7876,7 +8254,7 @@ sub wrapped { return $self->{'wrapped'}; } -sub set_sshlogin { +sub set_sshlogin($$) { my $self = shift; my $sshlogin = shift; $self->{'sshlogin'} = $sshlogin; @@ -7893,12 +8271,12 @@ sub set_sshlogin { } } -sub sshlogin { +sub sshlogin($) { my $self = shift; return $self->{'sshlogin'}; } -sub string_base64 { +sub string_base64($) { # Base64 encode strings into 1000 byte blocks. # 1000 bytes is the largest word size csh supports # Input: @@ -7910,7 +8288,7 @@ sub string_base64 { return @base64; } -sub string_zip_base64 { +sub string_zip_base64($) { # Pipe string through 'bzip2 -9' and base64 encode it into 1000 # byte blocks. # 1000 bytes is the largest word size csh supports @@ -7937,7 +8315,7 @@ sub string_zip_base64 { return @base64; } -sub base64_zip_eval { +sub base64_zip_eval() { # Script that: # * reads base64 strings from @ARGV # * decodes them @@ -7977,7 +8355,7 @@ sub base64_zip_eval { return $script; } -sub base64_wrap { +sub base64_wrap($) { # base64 encode Perl code # Split it into chunks of < 1000 bytes # Prepend it with a decoder that eval's it @@ -7988,11 +8366,11 @@ sub base64_wrap { my $eval_string = shift; return "perl -e ". - ::shell_quote_scalar(base64_zip_eval())." ". + ::Q(base64_zip_eval())." ". join" ",::shell_quote(string_zip_base64($eval_string)); } -sub base64_eval { +sub base64_eval($) { # Script that: # * reads base64 strings from @ARGV # * decodes them @@ -8015,7 +8393,7 @@ sub base64_eval { return $script; } -sub sshlogin_wrap { +sub sshlogin_wrap($) { # Wrap the command with the commands needed to run remotely # Input: # $command = command to run @@ -8146,7 +8524,7 @@ sub sshlogin_wrap { } else { $bashfuncset = '$bashfunc = "";' } - if($ENV{"parallel_bash_environment"}) { + if($ENV{'parallel_bash_environment'}) { $bashfuncset .= '$bashfunc .= "eval\ \"\$parallel_bash_environment\"\;";'; } ::debug("base64",$envset,$bashfuncset,"\n"); @@ -8156,7 +8534,7 @@ sub sshlogin_wrap { my $self = shift; my $command = shift; # TODO test that *sh -c 'parallel --env' use *sh - if(not defined $self->{'sshlogin_wrap'}) { + if(not defined $self->{'sshlogin_wrap'}{$command}) { my $sshlogin = $self->sshlogin(); my $serverlogin = $sshlogin->serverlogin(); my $quoted_remote_command; @@ -8165,13 +8543,19 @@ sub sshlogin_wrap { if($serverlogin eq ":") { if($opt::workdir) { # Create workdir if needed. Then cd to it. - my $wd = $self->workdir(); + my $wd = $self->workdir(); if($opt::workdir eq "." or $opt::workdir eq "...") { # If $wd does not start with '/': Prepend $HOME $wd =~ s:^([^/]):$ENV{'HOME'}/$1:; } ::mkdir_or_die($wd); - $command = "cd ".::shell_quote_scalar($wd)." || exit 255; ".$command; + my $post = ""; + if($opt::workdir eq "...") { + $post = ";".exitstatuswrapper("rm -rf ".::Q($wd).";"); + + } + $command = "cd ".::Q($wd)." || exit 255; " . + $command . $post;; } if(@opt::env) { # Prepend with environment setter, which sets functions in zsh @@ -8186,18 +8570,18 @@ sub sshlogin_wrap { $command =~ /\n/) { # csh does not deal well with > 1000 chars in one word # csh does not deal well with $ENV with \n - $self->{'sshlogin_wrap'} = base64_wrap($perl_code); + $self->{'sshlogin_wrap'}{$command} = base64_wrap($perl_code); } else { - $self->{'sshlogin_wrap'} = "perl -e ".::shell_quote_scalar($perl_code); + $self->{'sshlogin_wrap'}{$command} = "perl -e ".::Q($perl_code); } } else { - $self->{'sshlogin_wrap'} = $command; + $self->{'sshlogin_wrap'}{$command} = $command; } } else { my $pwd = ""; if($opt::workdir) { # Create remote workdir if needed. Then cd to it. - my $wd = $self->workdir(); + my $wd = ::pQ($self->workdir()); $pwd = qq{system("mkdir","-p","--","$wd"); chdir "$wd" ||}. qq{print(STDERR "parallel: Cannot chdir to $wd\\n") && exit 255;}; } @@ -8205,10 +8589,8 @@ sub sshlogin_wrap { my $remote_command = $pwd.$envset.$bashfuncset. '@ARGV="'.::perl_quote_scalar($command).'";'. monitor_parent_sshd_script(); - $quoted_remote_command = "perl -e ". - ::shell_quote_scalar($remote_command); - my $dq_remote_command = - ::shell_quote_scalar($quoted_remote_command); + $quoted_remote_command = "perl -e ". ::Q($remote_command); + my $dq_remote_command = ::Q($quoted_remote_command); if(length $dq_remote_command > 999 or not $csh_friendly @@ -8217,8 +8599,7 @@ sub sshlogin_wrap { # csh does not deal well with > 1000 chars in one word # csh does not deal well with $ENV with \n $quoted_remote_command = - "perl -e ". - ::shell_quote_scalar(::shell_quote_scalar(base64_zip_eval()))." ". + "perl -e ". ::Q(::Q(base64_zip_eval()))." ". join" ",::shell_quote(::shell_quote(string_zip_base64($remote_command))); } else { $quoted_remote_command = $dq_remote_command; @@ -8234,9 +8615,9 @@ sub sshlogin_wrap { $post .= $self->sshcleanup(); if($post) { # We need to save the exit status of the job - $post = '_EXIT_status=$?; ' . $post . ' exit $_EXIT_status;'; + $post = exitstatuswrapper($post); } - $self->{'sshlogin_wrap'} = + $self->{'sshlogin_wrap'}{$command} = ($pre . "$sshcmd $serverlogin -- exec " . $quoted_remote_command @@ -8244,10 +8625,10 @@ sub sshlogin_wrap { . $post); } } - return $self->{'sshlogin_wrap'}; + return $self->{'sshlogin_wrap'}{$command}; } -sub transfer { +sub transfer($) { # Files to transfer # Non-quoted and with {...} substituted # Returns: @@ -8267,12 +8648,12 @@ sub transfer { return @transfer; } -sub transfersize { +sub transfersize($) { my $self = shift; return $self->{'transfersize'}; } -sub add_transfersize { +sub add_transfersize($) { my $self = shift; my $transfersize = shift; $self->{'transfersize'} += $transfersize; @@ -8281,7 +8662,7 @@ sub add_transfersize { $self->{'transfersize'}); } -sub sshtransfer { +sub sshtransfer($) { # Returns for each transfer file: # rsync $file remote:$workdir my $self = shift; @@ -8294,7 +8675,7 @@ sub sshtransfer { return join("",@pre); } -sub return { +sub return($) { # Files to return # Non-quoted and with {...} substituted # Returns: @@ -8304,7 +8685,7 @@ sub return { replace_placeholders($self->{'commandline'}{'return_files'},0,0); } -sub returnsize { +sub returnsize($) { # This is called after the job has finished # Returns: # $number_of_bytes transferred in return @@ -8317,7 +8698,7 @@ sub returnsize { return $self->{'returnsize'}; } -sub add_returnsize { +sub add_returnsize($) { my $self = shift; my $returnsize = shift; $self->{'returnsize'} += $returnsize; @@ -8326,15 +8707,14 @@ sub add_returnsize { $self->{'returnsize'}); } -sub sshreturn { +sub sshreturn($) { # Returns for each return-file: # rsync remote:$workdir/$file . my $self = shift; my $sshlogin = $self->sshlogin(); my $sshcmd = $sshlogin->sshcommand(); my $serverlogin = $sshlogin->serverlogin(); - my $rsync_opts = $ENV{'PARALLEL_RSYNC_OPTS'}. - " -e".::shell_quote_scalar($sshcmd); + my $rsync_opts = $ENV{'PARALLEL_RSYNC_OPTS'}. " -e". ::Q($sshcmd); my $pre = ""; for my $file ($self->return()) { $file =~ s:^\./::g; # Remove ./ if any @@ -8355,9 +8735,8 @@ sub sshreturn { my $nobasedir = $file; $nobasedir =~ s:.*/\./::; $cd = ::shell_quote_file(::dirname($nobasedir)); - my $rsync_cd = '--rsync-path='.::shell_quote_scalar("cd $wd$cd; rsync"); - my $basename = - ::shell_quote_scalar(::shell_quote_file(::basename($file))); + my $rsync_cd = '--rsync-path='.::Q("cd $wd$cd; rsync"); + my $basename = ::Q(::shell_quote_file(::basename($file))); # --return # mkdir -p /home/tange/dir/subdir/; # rsync (--protocol 30) -rlDzR @@ -8370,7 +8749,7 @@ sub sshreturn { return $pre; } -sub sshcleanup { +sub sshcleanup($) { # Return the sshcommand needed to remove the file # Returns: # ssh command needed to remove files from sshlogin @@ -8386,12 +8765,12 @@ sub sshcleanup { $cleancmd .= $sshlogin->cleanup_cmd($file,$workdir).";"; } if(defined $opt::workdir and $opt::workdir eq "...") { - $cleancmd .= "$sshcmd $serverlogin -- rm -rf " . ::shell_quote_scalar($workdir).';'; + $cleancmd .= "$sshcmd $serverlogin -- rm -rf " . ::Q($workdir).';'; } return $cleancmd; } -sub remote_cleanup { +sub remote_cleanup($) { # Returns: # Files to remove at cleanup my $self = shift; @@ -8404,7 +8783,20 @@ sub remote_cleanup { } } -sub workdir { +sub exitstatuswrapper(@) { + if($Global::cshell) { + return ('set _EXIT_status=$status; ' . + join(" ",@_). + 'exit $_EXIT_status;'); + } else { + return ('_EXIT_status=$?; ' . + join(" ",@_). + 'exit $_EXIT_status;'); + } +} + + +sub workdir($) { # Returns: # the workdir on a remote machine my $self = shift; @@ -8455,12 +8847,12 @@ sub workdir { } else { $workdir = "."; } - $self->{'workdir'} = ::shell_quote_scalar($workdir); + $self->{'workdir'} = $workdir; } return $self->{'workdir'}; } -sub parentdirs_of { +sub parentdirs_of($) { # Return: # all parentdirs except . of this dir or file - sorted desc by length my $d = shift; @@ -8473,7 +8865,7 @@ sub parentdirs_of { return @parents; } -sub start { +sub start($) { # Setup STDOUT and STDERR for a job and start it. # Returns: # job-object or undef if job not to run @@ -8608,7 +9000,7 @@ sub start { ::set_fh_non_blocking($stdin_fh); } $job->set_fh(0,"w",$stdin_fh); - if($opt::tee) { $job->set_virgin(0); } + if($opt::tee or $opt::shard) { $job->set_virgin(0); } } elsif ($opt::tty and -c "/dev/tty" and open(my $devtty_fh, "<", "/dev/tty")) { # Give /dev/tty to the command if no one else is using it @@ -8652,16 +9044,20 @@ sub start { } } -sub interactive_start { +sub interactive_start($) { my $self = shift; my $command = $self->wrapped(); if($Global::interactive) { + my $answer; ::status_no_nl("$command ?..."); - open(my $tty_fh, "<", "/dev/tty") || ::die_bug("interactive-tty"); - my $answer = <$tty_fh>; - close $tty_fh; - my $run_yes = ($answer =~ /^\s*y/i); - if (not $run_yes) { + do{ + open(my $tty_fh, "<", "/dev/tty") || ::die_bug("interactive-tty"); + $answer = <$tty_fh>; + close $tty_fh; + # Sometime we get an empty string (not even \n) + # Do not know why, so let us just ignore it and try again + } while(length $answer < 1); + if (not ($answer =~ /^\s*y/i)) { $self->{'commandline'}->skip(); } } else { @@ -8672,7 +9068,7 @@ sub interactive_start { { my $tmuxsocket; - sub tmux_wrap { + sub tmux_wrap($) { # Wrap command with tmux for session pPID # Input: # $actual_command = the actual command being run (incl ssh wrap) @@ -8701,7 +9097,7 @@ sub interactive_start { # ; causes problems # ascii 194-245 annoys tmux $title =~ tr/[\011-\016;\302-\365]/ /s; - $title = ::shell_quote_scalar($title); + $title = ::Q($title); my $l_act = length($actual_command); my $l_tit = length($title); @@ -8709,7 +9105,7 @@ sub interactive_start { # The line to run contains a 118 chars extra code + the title 2x my $l_tot = 2 * $l_tit + $l_act + $l_fifo; - my $quoted_space75 = ::shell_quote_scalar(" ")x75; + my $quoted_space75 = ::Q(" ")x75; while($l_tit < 1000 and ( (890 < $l_tot and $l_tot < 1350) @@ -8753,7 +9149,7 @@ sub interactive_start { return "mkfifo $tmpfifo && $tmux ". # Run in tmux - ::shell_quote_scalar + ::Q ( "(".$actual_command.');'. # The triple print is needed - otherwise the testsuite fails @@ -8768,7 +9164,7 @@ sub interactive_start { } } -sub is_already_in_results { +sub is_already_in_results($) { # Do we already have results for this job? # Returns: # $job_already_run = bool whether there is output for this or not @@ -8778,17 +9174,17 @@ sub is_already_in_results { return(-e $out."stdout" or -f $out); } -sub is_already_in_joblog { +sub is_already_in_joblog($) { my $job = shift; return vec($Global::job_already_run,$job->seq(),1); } -sub set_job_in_joblog { +sub set_job_in_joblog($) { my $job = shift; vec($Global::job_already_run,$job->seq(),1) = 1; } -sub should_be_retried { +sub should_be_retried($) { # Should this job be retried? # Returns # 0 - do not retry @@ -8823,7 +9219,7 @@ sub should_be_retried { { my (%print_later,$job_seq_to_print); - sub print_earlier_jobs { + sub print_earlier_jobs($) { # Print jobs whose output is postponed due to --keep-order # Returns: N/A my $job = shift; @@ -8850,7 +9246,7 @@ sub should_be_retried { } } -sub print { +sub print($) { # Print the output of the jobs # Returns: N/A @@ -8904,7 +9300,7 @@ sub print { } flush $out_fd; } - ::debug("print", "<{'exitstatus'} and not ($self->virgin() and $opt::pipe)) { if($Global::joblog and not $opt::sqlworker) { @@ -8925,14 +9321,14 @@ sub print { { my $header_printed; - sub print_csv { + sub print_csv($) { my $self = shift; my $cmd; if($Global::verbose <= 1) { $cmd = $self->replaced(); } else { # Verbose level > 1: Print the rsync and stuff - $cmd = "@command"; + $cmd = join " ", @{$self->{'commandline'}}; } my $record_ref = $self->{'commandline'}{'arg_list_flat_orig'}; @@ -8975,7 +9371,7 @@ sub print { } } -sub combine_ref { +sub combine_ref($) { # Inspired by Text::CSV_PP::_combine (by Makamaka Hannyaharamitu) my @part = @_; my $sep = $Global::csvsep; @@ -9022,7 +9418,7 @@ sub combine_ref { return @out; } -sub print_files { +sub print_files($) { # Print the name of the file containing stdout on stdout # Uses: # $opt::pipe @@ -9063,7 +9459,7 @@ sub print_files { } } -sub print_linebuffer { +sub print_linebuffer($) { my $self = shift; my ($fdno,$in_fh,$out_fd) = @_; if(defined $self->{'exitstatus'}) { @@ -9097,8 +9493,11 @@ sub print_linebuffer { my $outputlength = 0; my $halfline_ref = $self->{'halfline'}{$fdno}; my ($buf,$i,$rv); - while($rv = sysread($in_fh, $buf, 131072)) { + # 1310720 gives 1.2 GB/s + # 131072 gives 0.9 GB/s + while($rv = sysread($in_fh, $buf,1310720)) { $outputlength += $rv; + # TODO --recend # Treat both \n and \r as line end $i = (rindex($buf,"\n")+1) || (rindex($buf,"\r")+1); if($i) { @@ -9106,6 +9505,7 @@ sub print_linebuffer { if($opt::tag or defined $opt::tagstring) { # Replace ^ with $tag within the full line my $tag = $self->tag(); + # TODO --recend that can be partially in @$halfline_ref substr($buf,0,$i-1) =~ s/(?<=[\n\r])/$tag/gm; # The length changed, so find the new ending pos $i = (rindex($buf,"\n")+1) || (rindex($buf,"\r")+1); @@ -9135,7 +9535,11 @@ sub print_linebuffer { # read remaining my $halfline_ref = $self->{'halfline'}{$fdno}; if(grep /./, @$halfline_ref) { - $self->add_returnsize(length join("",@$halfline_ref)); + my $returnsize = 0; + for(@{$self->{'halfline'}{$fdno}}) { + $returnsize += length $_; + } + $self->add_returnsize($returnsize); if($opt::tag or defined $opt::tagstring) { # Prepend $tag the the remaining half line unshift @$halfline_ref, $self->tag(); @@ -9164,7 +9568,7 @@ sub print_linebuffer { } } -sub print_tag { +sub print_tag(@) { return print_normal(@_); } @@ -9178,7 +9582,7 @@ sub free_ressources() { } } -sub print_normal { +sub print_normal($) { my $self = shift; my ($fdno,$in_fh,$out_fd) = @_; my $buf; @@ -9224,14 +9628,14 @@ sub print_normal { } } -sub print_joblog { +sub print_joblog($) { my $self = shift; my $cmd; if($Global::verbose <= 1) { $cmd = $self->replaced(); } else { # Verbose level > 1: Print the rsync and stuff - $cmd = "@command"; + $cmd = join " ", @{$self->{'commandline'}}; } # Newlines make it hard to parse the joblog $cmd =~ s/\n/\0/g; @@ -9245,7 +9649,7 @@ sub print_joblog { $self->set_job_in_joblog(); } -sub tag { +sub tag($) { my $self = shift; if(not defined $self->{'tag'}) { if($opt::tag or defined $opt::tagstring) { @@ -9258,7 +9662,7 @@ sub tag { return $self->{'tag'}; } -sub hostgroups { +sub hostgroups($) { my $self = shift; if(not defined $self->{'hostgroups'}) { $self->{'hostgroups'} = @@ -9267,12 +9671,12 @@ sub hostgroups { return @{$self->{'hostgroups'}}; } -sub exitstatus { +sub exitstatus($) { my $self = shift; return $self->{'exitstatus'}; } -sub set_exitstatus { +sub set_exitstatus($$) { my $self = shift; my $exitstatus = shift; if($exitstatus) { @@ -9288,17 +9692,17 @@ sub set_exitstatus { $exitstatus); } -sub reset_exitstatus { +sub reset_exitstatus($) { my $self = shift; undef $self->{'exitstatus'}; } -sub exitsignal { +sub exitsignal($) { my $self = shift; return $self->{'exitsignal'}; } -sub set_exitsignal { +sub set_exitsignal($$) { my $self = shift; my $exitsignal = shift; $self->{'exitsignal'} = $exitsignal; @@ -9399,7 +9803,7 @@ sub set_exitsignal { package CommandLine; -sub new { +sub new($) { my $class = shift; my $seq = shift; my $commandref = shift; @@ -9434,17 +9838,17 @@ sub new { }, ref($class) || $class; } -sub seq { +sub seq($) { my $self = shift; return $self->{'seq'}; } -sub set_seq { +sub set_seq($$) { my $self = shift; $self->{'seq'} = shift; } -sub slot { +sub slot($) { # Find the number of a free job slot and return it # Uses: # @Global::slots - list with free jobslots @@ -9464,7 +9868,7 @@ sub slot { { my $already_spread; - sub populate { + sub populate($) { # Add arguments from arg_queue until the number of arguments or # max line length is reached # Uses: @@ -9551,7 +9955,7 @@ sub slot { } } -sub push { +sub push($) { # Add one or more records as arguments # Returns: N/A my $self = shift; @@ -9580,7 +9984,7 @@ sub push { } } -sub pop { +sub pop($) { # Remove last argument # Returns: # the last record @@ -9608,7 +10012,7 @@ sub pop { return $record; } -sub pop_all { +sub pop_all($) { # Remove all arguments and zeros the length of replacement perlexpr # Returns: # all records @@ -9623,7 +10027,7 @@ sub pop_all { return @popped; } -sub number_of_args { +sub number_of_args($) { # The number of records # Returns: # number of records @@ -9632,7 +10036,7 @@ sub number_of_args { return $#{$self->{'arg_list'}}+1; } -sub number_of_recargs { +sub number_of_recargs($) { # The number of args in records # Returns: # number of args records @@ -9645,7 +10049,7 @@ sub number_of_recargs { return $sum; } -sub args_as_string { +sub args_as_string($) { # Returns: # all unmodified arguments joined with ' ' (similar to {}) my $self = shift; @@ -9653,7 +10057,7 @@ sub args_as_string { map { @$_ } @{$self->{'arg_list'}}); } -sub results_out { +sub results_out($) { sub max_file_name_length { # Figure out the max length of a subdir # TODO and the max total length @@ -9729,7 +10133,7 @@ sub results_out { return $out; } -sub args_as_dirname { +sub args_as_dirname($) { # Returns: # all unmodified arguments joined with '/' (similar to {}) # \t \0 \\ and / are quoted as: \t \0 \\ \_ @@ -9762,7 +10166,7 @@ sub args_as_dirname { return join "/", @res; } -sub header_indexes_sorted { +sub header_indexes_sorted($) { # Sort headers first by number then by name. # E.g.: 1a 1b 11a 11b # Returns: @@ -9785,9 +10189,9 @@ sub header_indexes_sorted { return @header_indexes_sorted; } -sub len { +sub len($) { # Uses: - # $opt::shellquote + # @opt::shellquote # The length of the command line with args substituted my $self = shift; my $len = 0; @@ -9825,22 +10229,35 @@ sub len { $self->{'replacecount'}{$replstring}; } } + if(defined $Global::parallel_env) { + # If we are using --env, add the prefix for that, too. + $len += length $Global::parallel_env; + } if($Global::quoting) { # Pessimistic length if -q is set - # Worse than worst case: every char needs to be quoted with \ - $len *= 2; + # Worse than worst case: ' => "'" + " => '"' + # TODO can we count the number of expanding chars? + # and count them in arguments, too? + $len *= 3; } - if($opt::shellquote) { + if(@opt::shellquote) { # Pessimistic length if --shellquote is set - # Worse than worst case: every char needs to be quoted with \ twice - $len *= 4; + # Worse than worst case: ' => "'" + for(@opt::shellquote) { + $len *= 3; + } + $len *= 5; } - # If we are using --env, add the prefix for that, too. - $len += 0; + if(@opt::sshlogin) { + # Pessimistic length if remote + # Worst case is BASE64 encoding 3 bytes -> 4 bytes + $len = int($len*4/3); + } + return $len; } -sub replaced { +sub replaced($) { # Uses: # $Global::noquote # $Global::quoting @@ -9867,163 +10284,194 @@ sub replaced { return $self->{'replaced'}; } -{ - my @target; - my $context_replace; - my $perl_expressions_as_re; - my @arg; - my %words_with_rpl_strings; +sub replace_placeholders($$$$) { + # Replace foo{}bar with fooargbar + # Input: + # $targetref = command as shell words + # $quote = should everything be quoted? + # $quote_arg = should replaced arguments be quoted? + # Uses: + # @Arg::arg = arguments as strings to be use in {= =} + # Returns: + # @target with placeholders replaced + my $self = shift; + my $targetref = shift; + my $quote = shift; + my $quote_arg = shift; + my %replace; - sub fish_out_words_with_rpl_strings { - if(not $words_with_rpl_strings{$context_replace,@target}) { - my %word; - for (@target) { - my $tt = $_; - ::debug("replace", "Target: $tt"); - # Command line template: - # a{1}b{}c{}d - # becomes: - # a{=1 $_=$_ =}b{= $_=$_ =}c{= $_=$_ =}d - # becomes: - # a\257<1 $_=$_ \257>b\257< $_=$_ \257>c\257< $_=$_ \257>d - # Input A B C (no context) becomes: - # A B C => aAbA B CcA B Cd - # Input A B C (context -X) becomes: - # A B C => aAbAcAd aAbBcBd aAbCcCd - if($context_replace) { - while($tt =~ s/([^\s\257]* # before {= - (?: - \257< # {= - (?: (?! \257[<>]). )* # The perl expression - \257> # =} - [^\s\257]* # after =} - )+)/ /xs) { - # $1 = pre \257< perlexpr \257> post - $word{"$1"} ||= 1; - } - } else { - while($tt =~ s/( \257<(?: (?! \257[<>]). )*\257> )//xs) { - # $1 = \257< perlexpr \257> - $word{$1} ||= 1; - } - } - } - @{$words_with_rpl_strings{$context_replace,@target}} = keys %word + # Token description: + # \0spc = unquoted space + # \0end = last token element + # \0ign = dummy token to be ignored + # \257<...\257> = replacement expression + # " " = quoted space, that splits -X group + # text = normal text - possibly part of -X group + my $spacer = 0; + my @tokens = grep { length $_ > 0 } map { + if(/^\257<|^ $/) { + # \257<...\257> or space + $_ + } else { + # Split each space/tab into a token + split /(?=\s)|(?<=\s)/ } - return @{$words_with_rpl_strings{$context_replace,@target}}; } + # Split \257< ... \257> into own token + map { split /(?=\257<)|(?<=\257>)/ } + # Insert "\0spc" between every element + # This space should never be quoted + map { $spacer++ ? ("\0spc",$_) : $_ } + map { $_ eq "" ? "\0empty" : $_ } + @$targetref; - sub replace_placeholders { - # Replace foo{}bar with fooargbar - # Uses: - # @Arg::arg = arguments as strings to be use in {= =} - # Input: - # $targetref = command as shell words - # $quote = should everything be quoted? - # $quote_arg = should replaced arguments be quoted? - # Returns: - # @target with placeholders replaced - my $self = shift; - my $targetref = shift; - my $quote = shift; - my $quote_arg = shift; - my %replace; - # -X = context replace (fish_out_words_with_rpl_strings) - $context_replace = $self->{'context_replace'}; - @target = @$targetref; - ::debug("replace", "Replace @target\n"); - if(not @target) { - # @target is empty: Return empty array - return @target; - } - # Make it possible to use $arg[2] in {= =} - *Arg::arg = $self->{'arg_list_flat_orig'}; - # Flat list: - # $self->{'arg_list'} = [ [Arg11, Arg12], [Arg21, Arg22], [Arg31, Arg32] ] - # $self->{'arg_list_flat'} = [ Arg11, Arg12, Arg21, Arg22, Arg31, Arg32 ] - if(not @{$self->{'arg_list_flat'}}) { - @{$self->{'arg_list_flat'}} = Arg->new(""); - } - my $argref = $self->{'arg_list_flat'}; - # Number of arguments - used for positional arguments - my $n = $#$argref+1; + if(not @tokens) { + # @tokens is empty: Return empty array + return @tokens; + } + ::debug("replace", "Tokens ".join":",@tokens,"\n"); + # Make it possible to use $arg[2] in {= =} + *Arg::arg = $self->{'arg_list_flat_orig'}; + # Flat list: + # $self->{'arg_list'} = [ [Arg11, Arg12], [Arg21, Arg22], [Arg31, Arg32] ] + # $self->{'arg_list_flat'} = [ Arg11, Arg12, Arg21, Arg22, Arg31, Arg32 ] + if(not @{$self->{'arg_list_flat'}}) { + @{$self->{'arg_list_flat'}} = Arg->new(""); + } + my $argref = $self->{'arg_list_flat'}; + # Number of arguments - used for positional arguments + my $n = $#$argref+1; - # $self is actually a CommandLine-object, - # but it looks nice to be able to say {= $job->slot() =} - my $job = $self; - $perl_expressions_as_re = - join("|", map {s/^-?\d+//; "\Q$_\E"} keys %{$self->{'replacecount'}}); - # Fish out the words that have replacement strings in them - for my $word (fish_out_words_with_rpl_strings()) { - # word = AB \257< perlexpr \257> CD \257< perlexpr \257> EF - ::debug("replace", "Replacing in $word\n"); - my $normal_replace; - - # for each arg: - # replace replacement strings with replacement in the word value - # push to replace word value - for my $arg (@$argref) { - my $val = $word; - # Replace {= perl expr =} with value for each arg - $val =~ s{\257<(-?\d+)?($perl_expressions_as_re)\257>} - { - if($1) { + # $self is actually a CommandLine-object, + # but it looks nice to be able to say {= $job->slot() =} + my $job = $self; + # @replaced = tokens with \257< \257> replaced + my @replaced; + if($self->{'context_replace'}) { + my @ctxgroup; + for my $t (@tokens,"\0end") { + # \0end = last token was end of tokens. + if($t eq "\t" or $t eq " " or $t eq "\0end" or $t eq "\0spc") { + # Context group complete: Replace in it + if(grep { /^\257} + { + if($1) { # Positional replace # Find the relevant arg and replace it ($argref->[$1 > 0 ? $1-1 : $n+$1] ? # If defined: replace $argref->[$1 > 0 ? $1-1 : $n+$1]-> replace($2,$quote_arg,$self) : ""); - } else { + } else { # Normal replace $normal_replace ||= 1; ($arg ? $arg->replace($2,$quote_arg,$self) : ""); - } - }gxe; - if($quote) { - CORE::push(@{$replace{::shell_quote_scalar($word)}}, - ::shell_quote_scalar($val)); + } + }sgxe; + $a + } @ctxgroup; + $normal_replace or last; + $space = "\0spc"; + } } else { - CORE::push(@{$replace{$word}}, $val); + # Context group has no a replacement string: Copy it once + CORE::push @replaced, @ctxgroup; } - # No normal replacements => only run once - $normal_replace or last; + # New context group + @ctxgroup=(); + } + if($t eq "\0spc" or $t eq " ") { + CORE::push @replaced,$t; + } else { + CORE::push @ctxgroup,$t; } } - *Arg::arg = []; - if($quote) { - @target = ::shell_quote(@target); - } - if(%replace) { - # Substitute the replace strings with the replacement values - # Must be sorted by length if a short word is a substring of a long word - my $regexp = join('|', map { my $s = $_; $s =~ s/(\W)/\\$1/g; $s } - sort { length $b <=> length $a } keys %replace); - for(@target) { - s/($regexp)/join(" ",@{$replace{$1}})/ge; - } - } - if($Global::escape_string_present) { - # Command line contains \257: Unescape it \257\256 => \257 - # If a replacement resulted in \257\256 - # it will have been escaped into \\\257\\\\256 - # and will not be matched below - for(@target) { - s/\257\256/\257/g; - } - if($opt::q) { - # \257 will be quoted too much - for(@target) { - s/\\\257\\\256/\\\257/g; + } else { + # @group = @token + # Replace in group + # Push output + # repquote = no if {} first on line, no if $quote, yes otherwise + for my $t (@tokens) { + if($t =~ /^\257} + { + if($1) { + # Positional replace + # Find the relevant arg and replace it + ($argref->[$1 > 0 ? $1-1 : $n+$1] ? # If defined: replace + $argref->[$1 > 0 ? $1-1 : $n+$1]-> + replace($2,$quote_arg,$self) + : ""); + } else { + # Normal replace + $normal_replace ||= 1; + ($arg ? $arg->replace($2,$quote_arg,$self) : ""); + } + }sgxe; + CORE::push @replaced, $space, $a; + $normal_replace or last; + $space = "\0spc"; } + } else { + # No replacement + CORE::push @replaced, $t; } } - ::debug("replace", "Return @target\n"); - return wantarray ? @target : "@target"; } + *Arg::arg = []; + ::debug("replace","Replaced: ".join":",@replaced,"\n"); + if($Global::escape_string_present) { + # Command line contains \257: Unescape it \257\256 => \257 + # If a replacement resulted in \257\256 + # it will have been escaped into \\\257\\\\256 + # and will not be matched below + for(@replaced) { + s/\257\256/\257/g; + } + } + + # Put tokens into groups that may be quoted. + my @quotegroup; + my @quoted; + for (map { $_ eq "\0empty" ? "" : $_ } + grep { $_ ne "\0ign" and $_ ne "\0noarg" and $_ ne "'\0noarg'" } + @replaced, "\0end") { + if($_ eq "\0spc" or $_ eq "\0end") { + # \0spc splits quotable groups + if($quote) { + if(@quotegroup) { + CORE::push @quoted, ::Q(join"",@quotegroup);; + } + } else { + CORE::push @quoted, join"",@quotegroup; + } + @quotegroup = (); + } else { + CORE::push @quotegroup, $_; + } + } + ::debug("replace","Quoted: ".join":",@quoted,"\n"); + return wantarray ? @quoted : "@quoted"; } -sub skip { +sub skip($) { # Skip this job my $self = shift; $self->{'skip'} = 1; @@ -10032,7 +10480,7 @@ sub skip { package CommandLineQueue; -sub new { +sub new($) { my $class = shift; my $commandref = shift; my $read_from = shift; @@ -10041,10 +10489,9 @@ sub new { my $transfer_files = shift; my $return_files = shift; my @unget = (); - my ($count,$posrpl,$perlexpr); + my $posrpl; my ($replacecount_ref, $len_ref); my @command = @$commandref; - my $dummy = ''; my $seq = 1; # Replace replacement strings with {= perl expr =} # '{=' 'perlexpr' '=}' => '{= perlexpr =}' @@ -10073,7 +10520,7 @@ sub new { # needed to force matching the shortest {= =} ((?:(?! \Q$Global::parensleft\E|\Q$Global::parensright\E ).)*?) \Q$Global::parensright\E ] # Match =} - {\257<$1\257>}gx; + {\257<$1\257>}gxs; for my $rpl (sort { length $b <=> length $a } keys %Global::rpl) { # Replace long --rpl's before short ones, as a short may be a # substring of a long: @@ -10095,7 +10542,7 @@ sub new { /xs; $grp_regexp ||= ''; my $rplval = $Global::rpl{$rpl}; - while(s{( (?: ^|\257> ) (?: (?! \257[<>])(?:.|\n) )*? ) + while(s{( (?: ^|\257> ) (?: [^\257]*|[\257][^<>] )*? ) # Don't replace after \257 unless \257> \Q$prefix\E $grp_regexp \Q$postfix\E} { @@ -10128,7 +10575,7 @@ sub new { # Only do this if the shorthand start with { $prefix=~s/^\{//; # Don't replace after \257 unless \257> - while(s{( (?: ^|\257> ) (?: (?! \257[<>]). )*? ) + while(s{( (?: ^|\257> ) (?: [^\257]*|[\257][^<>] )*? ) \{(-?\d+) \s* \Q$prefix\E $grp_regexp \Q$postfix\E} { # The start remains the same @@ -10189,7 +10636,7 @@ sub new { }, ref($class) || $class; } -sub merge_rpl_parts { +sub merge_rpl_parts($) { # '{=' 'perlexpr' '=}' => '{= perlexpr =}' # Input: # @in = the @command as given by the user @@ -10207,13 +10654,13 @@ sub merge_rpl_parts { my $s = shift @in; $_ = $s; # Remove matching (right most) parens - while(s/(.*)$l.*?$r/$1/o) {} + while(s/(.*)$l.*?$r/$1/os) {} if(/$l/o) { # Missing right parens while(@in) { $s .= " ".shift @in; $_ = $s; - while(s/(.*)$l.*?$r/$1/o) {} + while(s/(.*)$l.*?$r/$1/os) {} if(not /$l/o) { last; } @@ -10224,7 +10671,7 @@ sub merge_rpl_parts { return @out; } -sub replacement_counts_and_lengths { +sub replacement_counts_and_lengths($$@) { # Count the number of different replacement strings. # Find the lengths of context for context groups and non-context # groups. @@ -10248,7 +10695,7 @@ sub replacement_counts_and_lengths { my $noncontextlen = 0; my $contextgroups = 0; for my $c (@cmd) { - while($c =~ s/ \257<( (?: (?! \257[<>]). )*?)\257> /\000/xs) { + while($c =~ s/ \257<( (?: [^\257]*|[\257][^<>] )*?)\257> /\000/xs) { # %replacecount = { "perlexpr" => number of times seen } # e.g { "s/a/b/" => 2 } $replacecount{$1}++; @@ -10271,7 +10718,7 @@ sub replacement_counts_and_lengths { # Options that can contain replacement strings $_ or next; my $t = $_; - while($t =~ s/ \257<( (?: (?! \257[<>]). )* )\257> //xs) { + while($t =~ s/ \257<( (?: [^\257]*|[\257][^<>] )* )\257> //xs) { # %replacecount = { "perlexpr" => number of times seen } # e.g { "$_++" => 2 } # But for tagstring we just need to mark it as seen @@ -10308,7 +10755,7 @@ sub replacement_counts_and_lengths { return(\%replacecount,\%len,@command); } -sub get { +sub get($) { my $self = shift; if(@{$self->{'unget'}}) { my $cmd_line = shift @{$self->{'unget'}}; @@ -10355,43 +10802,39 @@ sub get { "(e.g. 'cat')."); ::wait_and_exit(255); } - } else { - if($cmd_line->number_of_args() == 0) { - # We did not get more args - maybe at EOF string? - return undef; - } elsif($cmd_line->replaced() eq "") { - # Empty command - get the next instead - return $self->get(); - } + } elsif($cmd_line->number_of_args() == 0) { + # We did not get more args - maybe at EOF string? + return undef; } $self->set_seq($self->seq()+1); return $cmd_line; } } -sub unget { +sub unget($) { my $self = shift; unshift @{$self->{'unget'}}, @_; } -sub empty { +sub empty($) { my $self = shift; - my $empty = (not @{$self->{'unget'}}) && $self->{'arg_queue'}->empty(); + my $empty = (not @{$self->{'unget'}}) && + $self->{'arg_queue'}->empty(); ::debug("run", "CommandLineQueue->empty $empty"); return $empty; } -sub seq { +sub seq($) { my $self = shift; return $self->{'seq'}; } -sub set_seq { +sub set_seq($$) { my $self = shift; $self->{'seq'} = shift; } -sub quote_args { +sub quote_args($) { my $self = shift; # If there is not command emulate |bash return $self->{'command'}; @@ -10401,7 +10844,7 @@ sub quote_args { package Limits::Command; # Maximal command line length (for -m and -X) -sub max_length { +sub max_length($) { # Find the max_length of a command line and cache it # Returns: # number of chars on the longest command line allowed @@ -10435,7 +10878,7 @@ sub max_length { return int($Limits::Command::line_max_len); } -sub real_max_length { +sub real_max_length($) { # Find the max_length of a command line # Returns: # The maximal command line length @@ -10450,7 +10893,9 @@ sub real_max_length { return binary_find_max_length(int($len/16),$len); } -sub binary_find_max_length { +# Prototype forwarding +sub binary_find_max_length($$); +sub binary_find_max_length($$) { # Given a lower and upper bound find the max_length of a command line # Returns: # number of chars on the longest command line allowed @@ -10465,22 +10910,22 @@ sub binary_find_max_length { } } -sub is_acceptable_command_line_length { +sub is_acceptable_command_line_length($) { # Test if a command line of this length can run # in the current environment # Returns: # 0 if the command line length is too long # 1 otherwise my $len = shift; - if($ENV{PARALLEL_ENV}) { - $len += length $ENV{PARALLEL_ENV} + (-s $ENV{PARALLEL_ENV})*2; + if($Global::parallel_env) { + $len += length $Global::parallel_env; } ::qqx("true "."x"x$len); ::debug("init", "$len=$? "); return not $?; } -sub tmux_length { +sub tmux_length($) { # If $opt::tmux set, find the limit for tmux # tmux 1.8 has a 2kB limit # tmux 1.9 has a 16kB limit @@ -10523,7 +10968,7 @@ sub tmux_length { package RecordQueue; -sub new { +sub new($) { my $class = shift; my $fhs = shift; my $colsep = shift; @@ -10546,7 +10991,7 @@ sub new { }, ref($class) || $class; } -sub get { +sub get($) { # Returns: # reference to array of Arg-objects my $self = shift; @@ -10563,17 +11008,23 @@ sub get { my $ret = $self->{'arg_sub_queue'}->get(); if($ret) { if(grep { index($_->orig(),"\0") > 0 } @$ret) { - # Allow for \0 in position 0 because GNU Parallel uses "\0" + # Allow for \0 in position 0 because GNU Parallel uses "\0noarg" # to mean no-string - ::warning("a NUL character occurred in the input.", - "It cannot be passed through in the argument list.", + ::warning("A NUL character in the input was replaced with \\0.", + "NUL cannot be passed through in the argument list.", "Did you mean to use the --null option?"); + for(grep { index($_->orig(),"\0") > 0 } @$ret) { + # Replace \0 with \\0 + my $a = $_->orig(); + $a =~ s/\0/\\0/g; + $_->set_orig($a); + } } if(defined $Global::max_number_of_args and $Global::max_number_of_args == 0) { ::debug("run", "Read 1 but return 0 args\n"); - # \0 => nothing (not the empty string) - map { $_->set_orig("\0"); } @$ret; + # \0noarg => nothing (not the empty string) + map { $_->set_orig("\0noarg"); } @$ret; } # Flush cached computed replacements in Arg-objects # To fix: parallel --bar echo {%} ::: a b c ::: d e f @@ -10582,22 +11033,22 @@ sub get { return $ret; } -sub unget { +sub unget($) { my $self = shift; - ::debug("run", "RecordQueue-unget '@_'\n"); + ::debug("run", "RecordQueue-unget\n"); $self->{'arg_number'} -= @_; unshift @{$self->{'unget'}}, @_; } -sub empty { +sub empty($) { my $self = shift; - my $empty = not @{$self->{'unget'}}; - $empty &&= $self->{'arg_sub_queue'}->empty(); + my $empty = (not @{$self->{'unget'}}) && + $self->{'arg_sub_queue'}->empty(); ::debug("run", "RecordQueue->empty $empty"); return $empty; } -sub arg_number { +sub arg_number($) { my $self = shift; return $self->{'arg_number'}; } @@ -10605,7 +11056,7 @@ sub arg_number { package RecordColQueue; -sub new { +sub new($) { my $class = shift; my $fhs = shift; my @unget = (); @@ -10616,7 +11067,7 @@ sub new { }, ref($class) || $class; } -sub get { +sub get($) { # Returns: # reference to array of Arg-objects my $self = shift; @@ -10659,16 +11110,16 @@ sub get { } } -sub unget { +sub unget($) { my $self = shift; ::debug("run", "RecordColQueue-unget '@_'\n"); unshift @{$self->{'unget'}}, @_; } -sub empty { +sub empty($) { my $self = shift; - my $empty = (not @{$self->{'unget'}} and - $self->{'arg_sub_queue'}->empty()); + my $empty = (not @{$self->{'unget'}}) && + $self->{'arg_sub_queue'}->empty(); ::debug("run", "RecordColQueue->empty $empty"); return $empty; } @@ -10676,7 +11127,7 @@ sub empty { package SQLRecordQueue; -sub new { +sub new($) { my $class = shift; my @unget = (); return bless { @@ -10684,7 +11135,7 @@ sub new { }, ref($class) || $class; } -sub get { +sub get($) { # Returns: # reference to array of Arg-objects my $self = shift; @@ -10694,13 +11145,13 @@ sub get { return $Global::sql->get_record(); } -sub unget { +sub unget($) { my $self = shift; ::debug("run", "SQLRecordQueue-unget '@_'\n"); unshift @{$self->{'unget'}}, @_; } -sub empty { +sub empty($) { my $self = shift; if(@{$self->{'unget'}}) { return 0; } my $get = $self->get(); @@ -10717,14 +11168,14 @@ package MultifileQueue; @Global::unget_argv=(); -sub new { +sub new($$) { my $class = shift; my $fhs = shift; for my $fh (@$fhs) { if(-t $fh and -t ($Global::status_fd || *STDERR)) { - ::warning("Input is read from the terminal. You either know what you", - "are doing (in which case: YOU ARE AWESOME!) or you forgot", - "::: or :::: or to pipe data into parallel. If so", + ::warning("Input is read from the terminal. You are either an expert", + "(in which case: YOU ARE AWESOME!) or maybe you forgot", + "::: or :::: or -a or to pipe data into parallel. If so", "consider going through the tutorial: man parallel_tutorial", "Press CTRL-D to exit."); } @@ -10736,7 +11187,7 @@ sub new { }, ref($class) || $class; } -sub get { +sub get($) { my $self = shift; if($opt::link) { return $self->link_get(); @@ -10745,16 +11196,16 @@ sub get { } } -sub unget { +sub unget($) { my $self = shift; ::debug("run", "MultifileQueue-unget '@_'\n"); unshift @{$self->{'unget'}}, @_; } -sub empty { +sub empty($) { my $self = shift; - my $empty = (not @Global::unget_argv - and not @{$self->{'unget'}}); + my $empty = (not @Global::unget_argv) && + not @{$self->{'unget'}}; for my $fh (@{$self->{'fhs'}}) { $empty &&= eof($fh); } @@ -10762,7 +11213,7 @@ sub empty { return $empty; } -sub link_get { +sub link_get($) { my $self = shift; if(@{$self->{'unget'}}) { return shift @{$self->{'unget'}}; @@ -10792,7 +11243,7 @@ sub link_get { } } -sub nest_get { +sub nest_get($) { my $self = shift; if(@{$self->{'unget'}}) { return shift @{$self->{'unget'}}; @@ -10874,7 +11325,7 @@ sub nest_get { return shift @{$self->{'unget'}}; } -sub read_arg_from_fh { +sub read_arg_from_fh($) { # Read one Arg from filehandle # Returns: # Arg-object with one read line @@ -10947,7 +11398,9 @@ sub read_arg_from_fh { } } -sub expand_combinations { +# Prototype forwarding +sub expand_combinations(@); +sub expand_combinations(@) { # Input: # ([xmin,xmax], [ymin,ymax], ...) # Returns: ([x,y,...],[x,y,...]) @@ -10981,7 +11434,7 @@ sub expand_combinations { package Arg; -sub new { +sub new($) { my $class = shift; my $orig = shift; my @hostgroups; @@ -11012,41 +11465,40 @@ sub new { }, ref($class) || $class; } -sub Q { +sub Q($) { # Q alias for ::shell_quote_scalar - # Run shell_quote_scalar once to set the reference to the sub - my $a = ::shell_quote_scalar(@_); + no warnings 'redefine'; *Q = \&::shell_quote_scalar; - return $a; + return Q(@_); } -sub pQ { +sub pQ($) { # pQ alias for ::perl_quote_scalar *pQ = \&::perl_quote_scalar; return pQ(@_); } -sub total_jobs { +sub total_jobs() { return $Global::JobQueue->total_jobs(); } { my %perleval; my $job; - sub skip { + sub skip() { # shorthand for $job->skip(); $job->skip(); } - sub slot { + sub slot() { # shorthand for $job->slot(); $job->slot(); } - sub seq { + sub seq() { # shorthand for $job->seq(); $job->seq(); } - sub replace { + sub replace($$$$) { # Calculates the corresponding value for a given perl expression # Returns: # The calculated string (quoted if asked for) @@ -11086,28 +11538,28 @@ sub total_jobs { $self->{'cache'}{$perlexpr} = $_; } # Return the value quoted if needed - return($quote ? ::shell_quote_scalar($self->{'cache'}{$perlexpr}) + return($quote ? Q($self->{'cache'}{$perlexpr}) : $self->{'cache'}{$perlexpr}); } } -sub flush_cache { +sub flush_cache($) { # Flush cache of computed values my $self = shift; $self->{'cache'} = undef; } -sub orig { +sub orig($) { my $self = shift; return $self->{'orig'}; } -sub set_orig { +sub set_orig($$) { my $self = shift; $self->{'orig'} = shift; } -sub trim_of { +sub trim_of($) { # Removes white space as specifed by --trim: # n = nothing # l = start @@ -11135,7 +11587,7 @@ sub trim_of { package TimeoutQueue; -sub new { +sub new($) { my $class = shift; my $delta_time = shift; my ($pct); @@ -11156,22 +11608,22 @@ sub new { }, ref($class) || $class; } -sub delta_time { +sub delta_time($) { my $self = shift; return $self->{'delta_time'}; } -sub set_delta_time { +sub set_delta_time($$) { my $self = shift; $self->{'delta_time'} = shift; } -sub remedian { +sub remedian($) { my $self = shift; return $self->{'remedian'}; } -sub set_remedian { +sub set_remedian($$) { # Set median of the last 999^3 (=997002999) values using Remedian # # Rousseeuw, Peter J., and Gilbert W. Bassett Jr. "The remedian: A @@ -11187,7 +11639,7 @@ sub set_remedian { $self->{'remedian'} = (sort @{$rref->[2]})[$#{$rref->[2]}/2]; } -sub update_median_runtime { +sub update_median_runtime($) { # Update delta_time based on runtime of finished job if timeout is # a percentage my $self = shift; @@ -11199,7 +11651,7 @@ sub update_median_runtime { } } -sub process_timeouts { +sub process_timeouts($) { # Check if there was a timeout my $self = shift; # $self->{'queue'} is sorted by start time @@ -11223,7 +11675,7 @@ sub process_timeouts { } } -sub insert { +sub insert($) { my $self = shift; my $in = shift; push @{$self->{'queue'}}, $in; @@ -11232,7 +11684,7 @@ sub insert { package SQL; -sub new { +sub new($) { my $class = shift; my $dburl = shift; $Global::use{"DBI"} ||= eval "use DBI; 1;"; @@ -11278,7 +11730,9 @@ sub new { }, ref($class) || $class; } -sub get_alias { +# Prototype forwarding +sub get_alias($); +sub get_alias($) { my $alias = shift; $alias =~ s/^(sql:)*//; # Accept aliases prepended with sql: if ($alias !~ /^:/) { @@ -11338,7 +11792,7 @@ sub get_alias { } } -sub check_permissions { +sub check_permissions($) { my $file = shift; if(-e $file) { @@ -11357,12 +11811,12 @@ sub check_permissions { } } -sub parse_dburl { +sub parse_dburl($) { my $url = shift; my %options = (); # sql:mysql://[[user][:password]@][host][:port]/[database[/table][?query]] - if($url=~m!(?:sql:)? # You can prefix with 'sql:' + if($url=~m!^(?:sql:)? # You can prefix with 'sql:' ((?:oracle|ora|mysql|pg|postgres|postgresql)(?:s|ssl|)| (?:sqlite|sqlite2|sqlite3|csv)):// # Databasedriver ($1) (?: @@ -11388,7 +11842,7 @@ sub parse_dburl { \? (.*)? # Query ($8) )? - !ix) { + $!ix) { $options{databasedriver} = ::undef_if_empty(lc(uri_unescape($1))); $options{user} = ::undef_if_empty(uri_unescape($2)); $options{password} = ::undef_if_empty(uri_unescape($3)); @@ -11410,7 +11864,7 @@ sub parse_dburl { return %options; } -sub uri_unescape { +sub uri_unescape($) { # Copied from http://cpansearch.perl.org/src/GAAS/URI-1.55/URI/Escape.pm # to avoid depending on URI::Escape # This section is (C) Gisle Aas. @@ -11430,7 +11884,7 @@ sub uri_unescape { $str; } -sub run { +sub run($) { my $self = shift; my $stmt = shift; if($self->{'driver'} eq "CSV") { @@ -11487,7 +11941,7 @@ sub run { return $sth; } -sub get { +sub get($) { my $self = shift; my $sth = $self->run(@_); my @retval; @@ -11500,24 +11954,24 @@ sub get { return \@retval; } -sub table { +sub table($) { my $self = shift; return $self->{'table'}; } -sub append { +sub append($) { my $self = shift; return $self->{'append'}; } -sub update { +sub update($) { my $self = shift; my $stmt = shift; my $table = $self->table(); $self->run("UPDATE $table $stmt",@_); } -sub output { +sub output($) { my $self = shift; my $commandline = shift; @@ -11527,7 +11981,7 @@ sub output { join("",@{$commandline->{'output'}{2}})); } -sub max_number_of_args { +sub max_number_of_args($) { # Maximal number of args for this table my $self = shift; if(not $self->{'max_number_of_args'}) { @@ -11545,12 +11999,12 @@ sub max_number_of_args { return $self->{'max_number_of_args'}; } -sub set_max_number_of_args { +sub set_max_number_of_args($$) { my $self = shift; $self->{'max_number_of_args'} = shift; } -sub create_table { +sub create_table($) { my $self = shift; if($self->append()) { return; } my $max_number_of_args = shift; @@ -11584,7 +12038,7 @@ sub create_table { Stderr $TEXT);}); } -sub insert_records { +sub insert_records($) { my $self = shift; my $seq = shift; my $command_ref = shift; @@ -11592,20 +12046,20 @@ sub insert_records { my $table = $self->table(); # For SQL encode the command with \257 space as split points my $command = join("\257 ",@$command_ref); - my $v_cols = join ",", map { "V$_" } (1..$self->max_number_of_args()); + my @v_cols = map { ", V$_" } (1..$self->max_number_of_args()); # Two extra value due to $seq, Exitval, Send my $v_vals = join ",", map { "?" } (1..$self->max_number_of_args()+4); - $self->run("INSERT INTO $table (Seq,Command,Exitval,Send,$v_cols) ". + $self->run("INSERT INTO $table (Seq,Command,Exitval,Send @v_cols) ". "VALUES ($v_vals);", $seq, $command, -1000, 0, @$record_ref[1..$#$record_ref]); } -sub get_record { +sub get_record($) { my $self = shift; my @retval; my $table = $self->table(); - my $v_cols = join ",", map { "V$_" } (1..$self->max_number_of_args()); - my $v = $self->get("SELECT Seq, Command, $v_cols FROM $table ". + my @v_cols = map { ", V$_" } (1..$self->max_number_of_args()); + my $v = $self->get("SELECT Seq, Command @v_cols FROM $table ". "WHERE Exitval = -1000 ORDER BY Seq LIMIT 1;"); if($v->[0]) { my $val_ref = $v->[0]; @@ -11627,7 +12081,7 @@ sub get_record { } } -sub total_jobs { +sub total_jobs($) { my $self = shift; my $table = $self->table(); my $v = $self->get("SELECT count(*) FROM $table;"); @@ -11638,7 +12092,7 @@ sub total_jobs { } } -sub max_seq { +sub max_seq($) { my $self = shift; my $table = $self->table(); my $v = $self->get("SELECT max(Seq) FROM $table;"); @@ -11649,7 +12103,7 @@ sub max_seq { } } -sub finished { +sub finished($) { # Check if there are any jobs left in the SQL table that do not # have a "real" exitval my $self = shift; @@ -11675,7 +12129,7 @@ package Semaphore; # process holding the entry. If the process dies, the entry can be # taken by another process. -sub new { +sub new($) { my $class = shift; my $id = shift; my $count = shift; @@ -11699,7 +12153,7 @@ sub new { }, ref($class) || $class; } -sub remove_dead_locks { +sub remove_dead_locks($) { my $self = shift; my $lockdir = $self->{'lockdir'}; @@ -11717,7 +12171,7 @@ sub remove_dead_locks { } } -sub acquire { +sub acquire($) { my $self = shift; my $sleep = 1; # 1 ms my $start_time = time; @@ -11756,7 +12210,7 @@ sub acquire { ::debug("sem", "acquired $self->{'pid'}\n"); } -sub release { +sub release($) { my $self = shift; ::rm($self->{'pidfile'}); if($self->nlinks() == 1) { @@ -11771,7 +12225,7 @@ sub release { ::debug("run", "released $self->{'pid'}\n"); } -sub pid_change { +sub pid_change($) { # This should do what release()+acquire() would do without having # to re-acquire the semaphore my $self = shift; @@ -11784,7 +12238,7 @@ sub pid_change { ::rm($old_pidfile); } -sub atomic_link_if_count_less_than { +sub atomic_link_if_count_less_than($) { # Link $file1 to $file2 if nlinks to $file1 < $count my $self = shift; my $retval = 0; @@ -11806,7 +12260,7 @@ sub atomic_link_if_count_less_than { return $retval; } -sub nlinks { +sub nlinks($) { my $self = shift; if(-e $self->{'idfile'}) { return (stat(_))[3]; @@ -11815,7 +12269,7 @@ sub nlinks { } } -sub lock { +sub lock($) { my $self = shift; my $sleep = 100; # 100 ms my $total_sleep = 0; @@ -11878,7 +12332,7 @@ sub lock { ::debug("run", "locked $self->{'lockfile'}"); } -sub unlock { +sub unlock($) { my $self = shift; ::rm($self->{'lockfile'}); close $self->{'lockfh'}; @@ -11890,3 +12344,128 @@ sub unlock { $opt::x = $Semaphore::timeout = $Semaphore::wait = $Job::file_descriptor_warning_printed = $Global::envdef = @Arg::arg = $Global::max_slot_number = $opt::session; + +package main; + +sub main() { + save_stdin_stdout_stderr(); + save_original_signal_handler(); + parse_options(); + ::debug("init", "Open file descriptors: ", join(" ",keys %Global::fd), "\n"); + my $number_of_args; + if($Global::max_number_of_args) { + $number_of_args = $Global::max_number_of_args; + } elsif ($opt::X or $opt::m or $opt::xargs) { + $number_of_args = undef; + } else { + $number_of_args = 1; + } + + my @command = @ARGV; + my @input_source_fh; + if($opt::pipepart) { + if($opt::tee) { + @input_source_fh = map { open_or_exit($_) } @opt::a; + # Remove the first: It will be the file piped. + shift @input_source_fh; + if(not @input_source_fh and not $opt::pipe) { + @input_source_fh = (*STDIN); + } + } else { + # -a is used for data - not for command line args + @input_source_fh = map { open_or_exit($_) } "/dev/null"; + } + } else { + @input_source_fh = map { open_or_exit($_) } @opt::a; + if(not @input_source_fh and not $opt::pipe) { + @input_source_fh = (*STDIN); + } + } + if($opt::sqlmaster) { + # Create SQL table to hold joblog + output + $Global::sql->create_table($#input_source_fh+1); + if($opt::sqlworker) { + # Start a real --sqlworker in the background later + $Global::start_sqlworker = 1; + $opt::sqlworker = undef; + } + } + + if($opt::skip_first_line) { + # Skip the first line for the first file handle + my $fh = $input_source_fh[0]; + <$fh>; + } + + set_input_source_header(\@command,\@input_source_fh); + + if($opt::filter_hosts and (@opt::sshlogin or @opt::sshloginfile)) { + # Parallel check all hosts are up. Remove hosts that are down + filter_hosts(); + } + + if($opt::nonall or $opt::onall) { + onall(\@input_source_fh,@command); + wait_and_exit(min(undef_as_zero($Global::exitstatus),254)); + } + + $Global::JobQueue = JobQueue->new( + \@command,\@input_source_fh,$Global::ContextReplace, + $number_of_args,\@Global::transfer_files,\@Global::ret_files); + + if($opt::pipepart) { + pipepart_setup(); + } elsif($opt::pipe and $opt::tee) { + pipe_tee_setup(); + } elsif($opt::pipe and $opt::shard) { + pipe_shard_setup(); + } + + if($opt::eta or $opt::bar or $opt::shuf or $Global::halt_pct) { + # Count the number of jobs or shuffle all jobs + # before starting any. + # Must be done after ungetting any --pipepart jobs. + $Global::JobQueue->total_jobs(); + } + # Compute $Global::max_jobs_running + # Must be done after ungetting any --pipepart jobs. + max_jobs_running(); + + init_run_jobs(); + my $sem; + if($Global::semaphore) { + $sem = acquire_semaphore(); + } + $SIG{TERM} = $Global::original_sig{TERM}; + $SIG{HUP} = \&start_no_new_jobs; + + if($opt::tee or $opt::shard) { + # All jobs must be running in parallel for --tee/--shard + while(start_more_jobs()) {} + $Global::start_no_new_jobs = 1; + if(not $Global::JobQueue->empty()) { + ::error("--tee requres --jobs to be higher. Try --jobs 0."); + ::wait_and_exit(255); + } + } elsif($opt::pipe and not $opt::pipepart) { + # Fill all jobslots + while(start_more_jobs()) {} + spreadstdin(); + } else { + # Reap one - start one + while(reaper() + start_more_jobs()) {} + } + ::debug("init", "Start draining\n"); + drain_job_queue(@command); + ::debug("init", "Done draining\n"); + reapers(); + ::debug("init", "Done reaping\n"); + if($Global::semaphore) { + $sem->release(); + } + cleanup(); + ::debug("init", "Halt\n"); + halt(); +} + +main(); diff --git a/README.md b/README.md index b82dc84..c8f36e3 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ Support is planned for two other operations: * Generate specs from audio files supported by sox * Rename folders based on the tags of the audio files inside -* **⇩ [Download Minat 0.1.5](http://www.profiteroles.org/downloads/Minat_0.1.5.zip)** +* **⇩ [Download Minat 0.1.6](http://www.profiteroles.org/downloads/Minat_0.1.6.zip)** ## Screenshot diff --git a/bin/keys b/bin/.DS_Store old mode 100755 new mode 100644 similarity index 62% rename from bin/keys rename to bin/.DS_Store index 0b854bada585fb23dbef25b110a53c7f1e8fca9e..5008ddfcf53c02e82d7eee2e57c38e5672ef89f6 GIT binary patch literal 6148 zcmeH~Jr2S!425mzP>H1@V-^m;4Wg<&0T*E43hX&L&p$$qDprKhvt+--jT7}7np#A3 zem<@ulZcFPQ@L2!n>{z**++&mCkOWA81W14cNZlEfg7;MkzE(HCqgga^y>{tEnwC%0;vJ&^%eQ zLs35+`xjp>T0`Dz}(J#ckkEx4>K0n$=IbGjInm4k%t(YWFgcT+k+HG;(RdHE4?SZ`!;zS zEzk&?BI5Z84LKi{Mur=ki2n3ox7iqDV;GJ|6z1HJFBnv_%*(ghhRGl#(_~v~kI zYfo%A=89nb8rIcWU)Q?gonw^9IL~LfKAuaeSza(S;O2Y|4ZWyNU+Pc#yD{h4#6R)1 zqd$$Wi#o#yyZbxuofW0=smTvhT*)QQ$t0b3e1~klR=We?f78v{SN*5n>XUj-IeQ}H z(G8faAjD*h#${K9{{Z&w^Hd8lM$c|V>C6d`g@B_d&!VJuG$x8)1t!h9_G7=Jd<1C_ z$!*k@Qp5gnH$Z(WWIfm8W{<&v5X1Ikk)p0evPv?N9?zzM$(}%>as0S=ws-xbH!fd& zbIjaR*fmj$42|oCoQw1;NiCs` zM^0*qoIIv#=k>^mgqBqE-J^~taz@s4Ma}Dxm>mNH@g7BTcw3IFL5{$KIbmMbBf5`w zV}42!jbXGOX&%!dOP{B0OuGB#E8r{OE8r{OE8r{e-zsoAUj8Ls+8kVv{-6hyC${3{ z;$5>3XN0n}S(?}i1SjbX8=rc848Ce{^DAb)Afl@qdr>Y(YXQU;B$JA&WWFYC1*d)k zI6ND#4&05WPMh)SvG3zkFTE%lWxy|98sYo+*ZggN9O){)?X*N)n%#B_5Yc;$e zXV9oxT*C`OzXr?Fb-V$k`N0q7rfcDOcxvHqMZSovuFZ&9wH8DDRbx6Gcsv z^G2UMKA@(RQ3Y3J6z%Ga@&c}>jZs1&Alz1`as?pU0vvbuJ9sX`uZ5#|5^&b2#5YP*PPGed_?AZo-ZscjF!pwjOKU gZPNb>U{SX(gd5-OW9DMaf2W6|grmVWMe&fo0NRk|6aWAK diff --git a/test b/test deleted file mode 100644 index e69de29..0000000 diff --git a/version.txt b/version.txt index fa71c37..a192233 100755 --- a/version.txt +++ b/version.txt @@ -1 +1 @@ -0.1.5.3 \ No newline at end of file +0.1.6 \ No newline at end of file