From 1140ca8d56832ae529db0f353112ac192cdf9432 Mon Sep 17 00:00:00 2001 From: Andrew DeFaria Date: Mon, 9 Apr 2018 19:59:32 -0700 Subject: [PATCH] Various changes and additions for UCM and testing things --- bin/allmach | 10 +- cc/testclearcase.pl | 55 + conf/adefaria@gmail.com-takeout.zip | Bin 18413 -> 0 bytes cq/cqinfo.pl | 2 +- cqtool/cqtool.pl | 1560 +++++++++++++-------------- data/allmach | 44 + data/machines | 38 + data/windows | 24 + lib/Clearcase.pm | 63 +- lib/Clearcase/UCM/Activity.pm | 142 +-- lib/Clearcase/UCM/Baseline.pm | 98 +- lib/Clearcase/UCM/Component.pm | 353 ++++++ lib/Clearcase/UCM/Folder.pm | 443 ++++++++ lib/Clearcase/UCM/Project.pm | 342 ++++++ lib/Clearcase/UCM/Pvob.pm | 78 +- lib/Clearcase/UCM/Stream.pm | 222 +++- lib/Clearcase/UCM/Streams.pm | 165 +++ lib/Clearcase/UCM/testinfo.txt | 2 + lib/Clearcase/View.pm | 59 +- lib/Clearcase/Vob.pm | 22 +- lib/Clearcase/Vobs.pm | 2 +- lib/Clearquest.pm | 79 +- lib/OSDep.pm | 30 +- lib/Utils.pm | 10 +- rc/bash_login | 40 +- rc/clearcase | 78 +- rc/clearcase.conf | 4 +- rc/client_scripts/GD | 16 +- rc/client_scripts/ICANN | 0 rc/functions | 37 +- rc/perldb | 2 +- rc/set_colors | 36 +- rc/set_path | 2 + rc/system | 2 +- test/testclearcase.conf | 21 + test/testclearcase.pl | 893 ++++++++++++++- test/testclearquest.pl | 101 +- test/testspreadsheet.pl | 0 test/testspreadsheet.xls | Bin 39 files changed, 3793 insertions(+), 1282 deletions(-) create mode 100644 cc/testclearcase.pl delete mode 100644 conf/adefaria@gmail.com-takeout.zip mode change 100755 => 100644 cqtool/cqtool.pl create mode 100755 data/allmach create mode 100644 data/machines create mode 100644 data/windows create mode 100644 lib/Clearcase/UCM/Component.pm create mode 100644 lib/Clearcase/UCM/Folder.pm create mode 100644 lib/Clearcase/UCM/Project.pm create mode 100644 lib/Clearcase/UCM/Streams.pm create mode 100644 lib/Clearcase/UCM/testinfo.txt mode change 100755 => 100644 rc/client_scripts/ICANN create mode 100755 test/testclearcase.conf mode change 100755 => 100644 test/testspreadsheet.pl mode change 100644 => 100755 test/testspreadsheet.xls diff --git a/bin/allmach b/bin/allmach index 23ed8e5..6bbddde 100755 --- a/bin/allmach +++ b/bin/allmach @@ -64,11 +64,11 @@ function trap_intr { # Column 4 ClearCase Version (if applicable) # Column 5 Owner (if known) # Column 6 Usage (if known) -#oldIFS=$IFS -#IFS=":" +oldIFS=$IFS +IFS=":" declare -i nbr_of_machines=0 -#sed -e "/^#/d" $machines | -while read machine; do +IFS=: +while read machine model os cc owner usage; do machines[nbr_of_machines]=$machine let nbr_of_machines=nbr_of_machines+1 done < <(grep -v ^# $machines) @@ -86,7 +86,7 @@ while [ $i -lt $nbr_of_machines ]; do export currmachine=${machines[i]} # Execute command. Note if no command is given then the effect is to # ssh to each machine. - echo -e "${CYAN}${machines[i]}$NORMAL\c" + echo -e "${B_AQUA}${machines[i]}$NORMAL\c" echo -e ":$cmd" if [ $# -gt 0 ]; then if [ "$root_ssh" = "true" ]; then diff --git a/cc/testclearcase.pl b/cc/testclearcase.pl new file mode 100644 index 0000000..cf40c33 --- /dev/null +++ b/cc/testclearcase.pl @@ -0,0 +1,55 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use FindBin; +use Term::ANSIColor qw(:constants); + +use lib "$FindBin::Bin/../lib"; + +use Clearcase; +use Display; + +my ($status, @output) = $Clearcase::CC->execute ('pwv'); + +error 'Clearcase is not installed on this system', 1 + if $status; + +display YELLOW . "Global Clearcase Variables\n" . RESET; + +my $view_drive = $Clearcase::VIEW_DRIVE; +my $vob_mount = $Clearcase::VOB_MOUNT; +my $win_vob_prefix = $Clearcase::WIN_VOB_PREFIX; +my $vobtag_prefix = $Clearcase::VOBTAG_PREFIX; +my $countdb = $Clearcase::COUNTDB; + +display MAGENTA . "View Drive:\t\t" . RESET . $view_drive; +display MAGENTA . "VOB Mount:\t\t" . RESET . $vob_mount; +display MAGENTA . "Windows VOB prefix:\t" . RESET . $win_vob_prefix; +display MAGENTA . "VOB Tag Prefix:\t\t" . RESET . $vobtag_prefix; +display MAGENTA . "CountDB:\t\t" . RESET . $countdb; + +display CYAN . "\nGlobal Clearcase Configuration\n" . RESET; + +display MAGENTA . "Client:\t\t\t" . RESET . $Clearcase::CC->client; +display MAGENTA . "Hardware type:\t\t" . RESET . $Clearcase::CC->hardware_type; +display MAGENTA . "License host:\t\t" . RESET . $Clearcase::CC->license_host; +display MAGENTA . "OS:\t\t\t" . RESET . $Clearcase::CC->os; +display MAGENTA . "Region:\t\t\t" . RESET . $Clearcase::CC->region; +display MAGENTA . "Registry host:\t\t" . RESET . $Clearcase::CC->registry_host; +display MAGENTA . "Sitename:\t\t" . RESET . $Clearcase::CC->sitename; +display MAGENTA . "Version:\t\t" . RESET . $Clearcase::CC->version; + +display GREEN . "\nCleartool Access\n" . RESET; + +display_nolf MAGENTA . "Views:\t" . RESET; + +($status, @output) = $Clearcase::CC->execute ("lsview -s"); + +display scalar @output; + +display_nolf MAGENTA . "VOBs:\t" . RESET; + +($status, @output) = $Clearcase::CC->execute ("lsvob -s"); + +display scalar @output; diff --git a/conf/adefaria@gmail.com-takeout.zip b/conf/adefaria@gmail.com-takeout.zip deleted file mode 100644 index 2933e2ee7f1333a36e3154aa32cd7f28f24a21c0..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 18413 zcmb_^bC6~GvS!(~ZFbqVZC7>Kwry8++3K=w+qP}9r_X&ebI!dH@7?p>Ozzl!tk{t| zzE~^u%lvZ5O96wR06;)M00h-p3j+K_=m6LN489wi7&w?4@S9p2m|M{q*;>;&8CV+I zIy=!T8vp*$f!@){z`?=zJDr82t&OuC696Db)3eHdPpwmZ(`JJet!r8dp=)K!O>}Mq zFIHzbl34~DSmsRT;&QO~8~Yq)I7WoB#8~}&K0m&p?bG8M$vdva*TsqiP9Zb~M&tnp zH{UkLaiWhW(LgrU^Fa8@Id>}wt{fa(-K>F6CcYdTnMQU|;s7`%1*H{JMMWj^ZGfZl z)n&b#ynxce%^KF*Sma`rygwFw65_TP?GvfR8EQEZ?vBNz!%zj9wGD&`tF>~^*yy?a z$59o#fC^cU1L6e1qg69ic}n=Zj~be#Jy4vV6-o_^_Y4XqpPuhI zsXxRdK*=Lp85eVFm5R)7Fwv)RUOnVKI>N89kZmQfZgEsKDhK(smq_Rep??Apd`AGB zrkAF?p!xDNUV!D0JHKh%RHoLeX0T^Z!@_ zlS6v)W>p%LFE7)>lC_!BG!Dq3yq7B3U~GN4{qRUKd38?LiLJAAIq^80sWHD#F1vWB zyYx=cDYKeuP_|}cNuyfeSs2>q7NU6G+q%xkmB1arbbCNdv|VquYz?&z%x|{#bAww` zDFtU7Fl9XKncC~#yp+FQ!#~+3EE6iY);wu1j<*>NWnJ3TOXqp1g#0eJ!EQaRtBEf= zaKA=LudAW_dBs7+H+0k_VuyP_iddsKu9sNN!LS#LL5M3 zx~Qu#e+wN+{?4(8Wi6H-g`XeD-+YILYPN0nXz0G$MtmY#=f@XXN|c%w8#>c@&_cBF zWqu)$^VWHc;@C#+(W@JA1!8Xm!K3y_*`?q@Uc6A4Y-LtXn3Ba5FXAKlUXji~a_Y~Y z9WO&3C%*s}PX?1?(QEZJ5Tzt<)6w?G&z;=UcM>XXOL*BWf7Wl_WRaDN#FTg7@-9Un zP__QzQzF zhFMv=#vh3@VtNrgmo)atXl@1y9 zS!G61H)}C>!ZEsh_j)XdDZ+r-=2#Cy_aaoTr>7q!yp4+U9RSk55Ro^7p#%tTrl~m8 z*0*>p(;XIRqOJ4KC4f%-h0@goJ+TdU+DmrsW%HP%-E(10>$8$LzP4KRbDxx7PD#tp zAx|(m-w74rK8x6*@U$R!=nMK7EWDq&Md16(TGk$8*StXb)=k=+3<`ANsi^w^^%^HA z6t~c&GL(&}+;(Ngs$nfg6Wo&fz<`TSqDRtYduM%QR;5f`%k_~Q(CAjg@xv6 z88w!n5MIY-HV>GsGh+(Ggh_Y4J5yofyV;cUj_uRjj9S-Tpv?Mv-S3_u?`O&L?XWyU zJ5R7917oe^7dz=&6w@SUv~t_{Rt(psdUm*%eA2#kA7)9i-`Zov@bme&hRF(UiBIKN zIoZYUH8@D!xwCL$yFor*x#{YU=+JHN-%mys&yVSII$OPND@QP6P$O1^-h{c8;8xXW zivjmL_1ipz6sy&*-nBu3>=}9Sj-T!0xjb_?S6U@QvhbTU>AYiC!x(B}Y5eO~Nlv8| zjN;@uM%;_5FY!l`UxB+B@ky%K_+CBH(=Bbe)Mk`&A8kKY zcrR}Jr*q-eIXe|dHFkCE+x_)h7Y+<-W&-%d;O7dY711WyFU+m)Y~Zb{U|7BngHvW( zD5~JzKwQNRcg=EFa4hIBu_&HadWa9sesARClF4_jag<^-F*N6z!3>QzHRIW`kcKDl zWVxDI{XPw9f;3OMz#Y%kPcMH00Tk}pZOI#ivS2RgJ`|GGIRXkSroA(<{sqG(>u+Ch=WC-5q)?>Zi%o%|vgRS_4T9 zTXr^E#18dzs75HIx}wqk#=G*pXKrkw6%0K9!xsLJtpow{azM+6K-{Fd0xlL@8CvZU zZUc<`^kp~WX@;3^sW7&vAYi#x_*U|oP88W1xtu)V_Ab2wXA*=a#?#;29=y*FaG+)! z%O#(!KuC$!#c_qrX(grfr9I}f1YOLfAfN27Z?sy$uMHt~re#lz`rKv$b)91v5WyP< z#LE$#EK~^JBypZb!$?$;#sV{6&5#6(UJnC*;4ebGI|gKy;f4O(oRW8d;Z9JH9}m4E zA;f~s;4#6nFa>}T_=tMDv-qi|jHN6htQgi@Et8JmkOVc71!M_0*25`zcOvaw=&2SA zczw7;g7saR$k+!T(;xu_lJr8jiwLg&DFUo%CobsIX8&W1sxWZn*yYLBV;0?YEtW0BM?wqo*qWC6E>qh&xyTq##y$zXDbM~w< zV(u>d1@yfpM--^cRlnBRvK~c_xg|SVYK#fJcao{=pZ3*aUfyv|MasE#YlK~#UJ#xI zoW#t1+~}WMJD?*q|fxlt%^~a^JuU422fBv%fo`qALAUM^uzIEtG#}>PF zjgtj4XAQbt<__Y$MxLaQQ~JR5y&_LSF6TxUi4;_)3^T9%l{l<*QqqZOHzx!|6%-e}=y&oW;;%ZMR-=}@;pX$4I}h3S z=~BJPb%FzO*~51uIZpFznAJ?CDM#{L_~WhYn^5%3^Yi=A;5niM{bh7N0bHOBg3Fve3T^DLxKn=gPUJV2>0h#9VRJEJ6$ZD; zr4o)~(CZaRfqprv;hL&n#)Ohtb}w2dt~;Yz#AJdDl*czXmZ|*f=WYTwhm2SGSW*fm z%Y#?KxZBU@?af#Q*3)*a8(ONkYE1n~V#M`LC!SkYtd_<`GK0Cf#)(vGnUEPQ!-8Wb zQ;b$3u5bNR7-Y0;P_w^)-Qq`7GfR^L1<4txtxpjfgq}R!-xW$enXryTJQ10TEOi%F z>psRj(k2hB;j{-8Q-8;4_8Kb0wRVdm&>U@BsVXv7N3hFp5VZ#F%^WEz*-T928K~Wp zYzug?vdgbpjodLy&IrveDTXDaURga17xsJvFCB zx`HR*fZUWnY7qpHUsR&@6Ve^eMf2bYcyYhwA zCWC?rjb)94==$a!>|__0FXj5Rc6L8)5m=HGSQM)fvMvXK*2$f{Qli)Qp7D-v!#fih zj+|wUX9;|FQaAR#EXyE>j&rnJ1nFy}GMsSC-nS2y!eiq0$X}=|Tk#g81)g^6COO@M zVrSG~F3(4qx{*0qTU$C- zk&m;8G27!Pr;djc@3${VIzjU2{7z~e%80V2MCaG3z(s{;&E~P?L zGMPPV6VSCfM21s#PA3e{%5;*0RBv&N4cmJ5Y{-rQ4-R9d&5eD@Nh9hhGFs09gJBt1O(lE-iE!HAiR6R&=};f=y&bIeZ^YZnv1+3BUbHY#ewaDXh>-;@tdQ8qHk0mOUjGN=D z*!9)o>1pq7-E;Z_>&X_lcl~^p_NyP|d8w9IxvyGt;>;^?!DT*G@UygG3(9BOfs;F| z%{6ZRdlP=6YtsDtWdl0dK64Z?UJ1=h`S>Zo;R9qBPV~?1UP@E6ZQJ!=7ARBS^=YKv z)-ItAK3VhLO;~|0h*ES@TPI4MY~)xOt>B{6&AJopk4}SL$`jL&o(HFe+FL8Q-BK7S z$ygs3UgdJGQpILRae6AAhZ4;s-XiiE@VI?VH&uDBi$jQb2w*GhmvH8pP){)@j#46A zD4hI)h*2^%oSE3hR)`~T5at%HkQ;|IHrS`4p%Cz7FqPJeb1XfH=v!#V1|Eo{x_~6z zW*g9m)1OH~V8JDJ!(Mc}Mmwbl(!l>b;SCyvLK+|$Ha2g@67RTCA!e@_sl}OT26I!t z2rfTLPgP~ur5srWpUIg$8%wN>or{tU`LRRMTCqOv9bk0g1DhYX! zI2fYvC#r-%TXg<+Xi~|A%xf4}s?2?pd{o;{S@BdkW4v9ai;<51?KCAZzxhh3ZvlJtQyavvSg9|lfqf1+ETJ|OP+dX{g9Ql_FP^C8_1F(Nn~n|BSjL&>TOJD|Q%CfIx9a7x9lo+~b*c@LbDGC&4Xx)~r{G6INVr<{ayd z-AzMgHWe}VFUN(4Q z<#yc3IJY<>q(kOw1r$QCd8rvzSHLJGkkr@nis-r8D~Twf7?N0;YSW+zK@u4X|1NOM z?Otgi_HnMCRD)1@!=)$okBu3;CiW1^xGlo&lGJ|8!Z6$+5KK+L8M~+vTSFJRHd5}m z{k?p9?h+s6TYz@~5T4&aK1pIAy^S;SA^UM~ODPJX+*>A3tsRH72~aW^vrzZp*kk#m zkmMMS!*nCN#KE!eUUE{0{ctZ7`bLs~p%r3EFkW-RR{|2<#E?)L7@}fIOo&|5iG|oRSj@Ihf4&%j6?87_%J|(m;p)qw|^%ekG&V49TP;s zKkJ|E{lz1udX!GWoo2P`7_NEzjnUYF62cxEas055;fdKMe?d-Oej3^41t9QkVAU z6|gV+A($D`62D=!Fb2^vhRk4%iqJ7EVb6>bu`3(f z%6Ry?^qun4Nq`AjawQrQ_JMlS!--T}YKIS{e3%J}8%%lc?W&{Z5{`SKJw{rIclA!_ zNDXGNb+?;F*+S%BnhrKM#kv-a9efU3nKBQcYjT~N?*4sD0EY;=4C4a_0RT9K{;#4F zCxFo3h)#}X2EUu9w1)1q{~T_d?f3uysk1Ya{(YSK&;G(Vh5;$y8-j?ZTy3IeaNGz8 zy}qddHClW{3sW5XsNuewE9uJW*RSn$?@9m=4nR)?r9Snf##v2OuEo+JGvZ_#nfMh( zG#!j)Z-`I7K^Cxc&I~ul$e=CK+H4VNZhe==J=-}bw}fD$8;FD5I2k*^^KW!5Suc2o zN5_juvhdG5*?dVqRg)Rpm|N{pYK@?Hk%52F46qk-aP}KNe*NQ4=6R_t?oXvG<#C(!ZwMXl)DYRQO7QE+QOv1$5kN8u4U=V8 z{_#s_1`#MDDk{Vy-Km9m_AtcJo(oqnt}Z5d!kMqnpH!v!j4WLB3Mn&QcP#0}|;q0TCm-VBGFt-5`riZ_uc% zfd&iS4A+xz2qD4~UELE%UKwGt6fr2|%}_CrLe)S7t-Vjl-JQ0(3_p{uPqtnwB87fo zq@x{qcYo_hqRQS5PS8u_ zG1_t+X4tG2y$%YpuPyeD>r+jg^P)BP#X{<(SmuRYTBHVU|5h((#Tw&W!( zgAnMT{|TCeHwjy&Tk>_Yt+TO|Evl1|nb3R4?fM{rJ(Bve&7NIKfmKzKOUW*CHp>R& zb+AWmjEF1qW6Ak1>Q9Yd>vNEM$enC=G767UQ-WyqCEb6x?Mer8(H0;8!2564{m+e! z7J&6{yY2t3C>Q|%$6$WZ{(Ect4^RDv)}{8T1GZSg7oVI$N@pu!0q04Z~umd++X-fG&7&_qu3kMNuN7ljX!cVkuO0)c=8GpW0ap)-P6F%@Hz z!z_)L^PHfT;y_D7HSO_e$qZfJl6C7w&nyGemibL{XU#3y`R|NMGJM%=WcJ*UDvn7* zj5kH2Rf}c;(x!QP9N9zhZ8kw^W6Gd{rWQ6qF#|$)WL+wZ@@2Th_f}XXhXkHXazGUW zJNk#Jo-^yGO)nC;N{6PLF>b;?S~c82+aB@vs#}V=LR2}3!n(sh)3Ru!998P4Kb7hF zjd;}LqVC-59wqx-uG2kf`?2{wvoo!{t-qO}+H#&5JJea0%>(3FSWll{7Dw48`dK}- z={ED-gzVdtFr7KS58C1T$?hprhYs0pgiuElw^Xr{NEPwT&lbv#EC}IFo?(1un5LDH zlpiYqj!?J8Ef4snG|;b{2FC=rnGZaN?hzm03N%U5T%~c2 zr_WpA>F$g9QjZ$ly=oUzdz1xvw!5i=MHWblVDha1BNni0PVR3&jAt398A?UJ+@Et# z*>LlAQ2TtI;uB?1#UGR*H826OEpo$?#vPR?nG2)P4~mzGAB>U=3j2>3`tM$1r9cGH z6UQIL+oAM=osFFE-%iAu&vlYOs*u5K;SHL?wtr0?Jjqa+q1$|_U-UY(T16FAi`sJ& zuUgc(NMMgLwp9_7uw6$^ zbsDbGuYEqE?fC%i#4dx>)A#TZeG|b62S2P|XM6M_l0K`hO^mLEB#Kmo+N8>AD8uIHV?$>wwK)lfWm}gh=puqcv0-P znH2=di%Vmt;wP}nLO?q+vhL8Q*t2S*T6E{m5n9V+q!(5dRfwAO^UC%F804Fs4WY<@ z3E<$XQ4J=r<~##Pb^LCRE`yIB^+YXMxR48qbZ%OxC_7j4^N`iV`Nvmy&8LniDw)B| zS)(ghe>2wNqvd5*7B!a2sVnE#h;4Mc!_4(Vr!RPcoq07x;*a3{Z^%|EPR3PdQ5!z@|II($W3TrKjSq&%;e-*5d2|una-0q={|NPE!M- zI9?F287q~hwPCBmxvsX=g=X6rMRmmYdktmdZmd8ubgE=zl^3v?NC}*?C>Q>j0IRpt zJTp(hVmE{U<3oz6`aKz!7jrra)E}cpyUF!$EBdw-LethHqjX{3dl(mhDGIMAB}0T#WwPU%LAdY+ohm zm7^()M}ZPKNzvIo3f$a+DA6AX4ILD4Jenhi4DM6fN z2gwi1gGER4w3H2(Wm5O@iP=X$3Yfu9^(X_bz@TScA*5nAt zFxg&-UG7Zi_b7s|q6m3-$8G|&&wz<_0f_YYrzozXtS{boBpgAP2_XTzBz8)YHK4;W2Z7#@o#kPfw$rk7 z?^Y?Tv9~F_Sg$`f9y(85pNIN&yrcC%XZLUwSwd*)WgV;(8y-j@^#qvK3`+b&*LO@f z;g2@PGhtx>0zP4Y-d7aW5aFpQY5ytRD`*;w^(BlF_l-J?{KZrk)%}QD2BCM*pB1)2 zLa?P7PS^6q zE0_)!=s0dg1EMQNa7L0safIDI@+PjDGL=|Jf{%R}G8LXBO3Yzt(y)@#p|C~H5qMQ{ zR>~HoP{J)glXkOUtUZkb>KZZg1uAX1QB1N(nZd=AMg)ISz_uhxvGcU=y!sZ=sD>hQ zZ4CYB0uvP)7RtBmHE63OSQq?nDI2&y(CR3{z*U#rpm{>yTjVpY2InZB%kmHV+2L`x z_SWhkWO!0%Bgjk+O7v|4&45>C8bnDMNfnA|dG4I=)nDfWd^J`htuPZ00Ll2MivY7j z4fCaq6Dnv@=WP5&9UgjofT->H(&L(SUhsp!8EB=%DGDU$!uRwE1vdxm zzoQek4#?CX=dwWz4Yt+*^ca6%n8b1(DL_THOcW;w=l8lUb;Is8woxFJHy{d3&g~e3 z5Kc;ICMXP0;Uy3!J|C>D@6`v;Wz7v90&X{7c8IlxcT_(3}G*GlT}^rrHo+X*6uSYM)4vY6GT#h`d-=0|07_iF#@il12{&f zv{6{Yg9ODjv8&UJly$@i33HRTK>$GcUI`N4h-xqq1N%oWI&iALQpK>Uy|z1shM;8= zv}OZq#S@r{gm*$`How2dqbOnpwB(PGDDD8wftt@H{o(R!x2@duD|pW=*=m*(C(W#@ zteYiLKvXm#l<+|}CJaW?>S;@LC?c6apBRTdL2Tie;S7ZXT=#M$;j56)?F==(3(v^a z`^`mxl`XFD>#L5{^>ka0Y0v;IY-H;f-V1weX1H$bhqtfWa`b7u%q>r+8&Ce_>*gME zfzx)S`x|WUmYfduS9S_(8aqT%JN0^$pl9`0!KQqzN!3jB+=%Zw*{AD{eQ7=c+S|sj zFp%`s_D%6Zl=YG*M!eXujn#-1Ts(rkzqFKmQ)wUk>-;VanisF(+xl^<-&1Jx9~-lm zTMf}_=#$yZ-1~c{{^aR1fgi&-Zr&GZXgW+#3=oMi4j`xfJ zgcLsT25&M?3=_t_k5LNbD=@^z4C!;@BFe2k zTMrP6Bxc;ZsA>cYBiZ>q=7|?$w32C;mzGM*a6uRJZ2Ye36Y$(~r-QZdY><{eK zz_FDpM-qC{^+n2Z7Vai&$6rF!Z}yLIfol= z>#yb2T&zDL|A}uSe7G)nTRGSs8|-8dhIW(a6;LYW(dnU(9qHzHWsXxv-KolebLud_vPXbm zAh`pQLeY||?NA1cSmH0M93#rkx_Cg3e%{XppK_4X{t6S?da%*oAR-#;R9cUkm}%&5 z_@&xDOZhPBUP;;2>M6$#I)mV9RAp2$C@$8S4)G{$EqATA!jo&>932%^n{Z$GKC=Ez z(Flru}iE%2ku?^480dlq~;F?JTauCli!VAtxK$I&IO71gPGN(7$&|j^HjPr2nOv(W<8zJ zI5-O;#SKgtoT0hTOwsKoI#T_fL0xCrc1hz)vf%*}KzhN9Swjba3Dc%q^GCaI&jPZ4w zSeAi%JdIVVZX|&)`O}TTduj3vONhM_4>FS^g`FFPED0-w>2uYikElr@$(iqY(UW=l zo+Y`EMS5q*08S446tO4*dpEEYp<%eeQ3?+9#}qmNfv(*4WN+DG9eAM}0)uIN=j!&- zulAC;NK6r z?9IbThw1#5OdS+qRKUfiVdDe&Y8Hex#3}76#K#@wh9}K^wZijO?s2Uu#C&a6)a{#L z$uI)h&PBTw8m>X1-KypS;0N`wn`Pg9TbPq&xI+m-qRh_AJg3P#^0e%TbpX|Uq~*f6 zyFX}rUSGR!=D$4H;ONRXtOy~_JuiLg*LVuqx%4WG7n5ZY!-G=nAHClu=`|6y zEO+6>JEkMux`5tYHEAQ~>~2?5ZmA2~&+!meQcd8ypp6M)4v2KU0v>un85OQ)NX-KU zsRoGx8+dSBD{l(Y3q=0gB2pF=*Ik07b48+ooH+ykzr>^3YZyO;5!xO9C# zuH(r4;8@lJbg5yK`=D!kaP47wIiy*VcUA2w#BNtf{izj7`8L+zg{MO{eX4)ezWFD} zer;~`8+a|Onb#>VLxY^fp$rhB`HT=bdwl_R^6Sof+K%w*<0Bm2N=X^fLg-u&4M8=+ z!`7{mDXRw2u|gr9bfYs_#2Q@vbOKwI1Xh{7{UtvL$sL$aLSo&h700cqhpk4f#gw+v zmQ;=*R%O*!FLgBnfH-odsj4fh!rt5kCIW0QvURs6SIjuBJ$ka7^VPeFSyw?!kLrpn zbk7(AdrMQ|K`rm_C|mmV+Cd>Aw_6}knSqtMr5+1##9pFnB;*5NgF&|;0g}vrh!4Xs zzZomk0+g63x#|VnC-Uf}1sB?)_+oSkU;qJ&ucVF*VcPk9$eIMrvGmS)CD?C;m)LIw z5w0ND>e@3<$@u=YhSfwxFYvmW4jGE2wEqNph`EFnNUUh>_O?aVcu||5myX% zgBVa$c>9y-;xv|tt%*cYtsy!#ID)hh>ow3#USm=Y|49~RLVgN3fKmkK- znpz2?#qyxX^XPXaZ|$)?V%_LscCy#2c5W@A*$UjqZ|kY<2b*h291PdyWaM+yp~!5- z=MPIIzL@O1Ew{=>+HWAmDMa|yf#q=q#y})fa#WN`+8(@D2-!*4FStW%hcyLW&+JH@ zEk>Hqk8vix_wVc$9J>x3{XXO`p_fP(0qdt)_%pfVW0-x8^y3<0GNT$jla0wTIAA=Wn7p3BYOgUW9ztwZI2PW@ib2qm;5>VbJnV%Pv}ZqW|k zt`nQxHdD2TNoIO|<gQ?@Fpx)a@pwbahIY1!-P zEzc|AM+qN{*Ko3d4X3R!f1PDFV2^8LG|rS>_gp!ZANZtN$!DUeoZQ;1w^Nct-H!gy%PD5{vp=i~6Zr-)JdO+_xm7UXj_6m?p8B z5vpUA`3w~C-4!aQExlrBQxUevL@9ZIRY~pPS3HfbgKj`Fhf}#i#zvFPFY*nmcRtA1 zwp#nLg(#QafvV7iWdFK@U$@#FA$|n1u1dTNE{;y`Wtu)@Q=X#*>vTatfetQ{i^@%n zd#j?H?XXqwPvb2BHtyL$X*kJMj;o+ADwAl9B+X7$pIMI9CeM3bL{FknKn41AF$jrv z<`pNb@4~PqSuW%EYnjNW&hLS{x%U$9<5UvioBN%EfdyN3FBg;JzhFO&Q~kes-^RBr z{pAAYz|ZMDt3i1seKm{^e_hkRD}NdX8gwsXH@$zloLjr^k6HHX{!T&rw;20k{abb= zxEE2}zhWn_bKduYI4+^u_+e=oY#e1e0)1lkkS9_OJ(SUi8%$vgO z$QISYRb^fmj}#wNQuhzkFu!}3cKevloWp71P6ICmn&hdbU$HN+YLJr)qBvL5@{fbm zyjBFOn|gVx_UXOD!o#QP`69@M z$PoCJI6n$AfPL!5nBgzJf3ipelY}2Y=W$-v1&fR(%N0FJlGbKMqfX=SYiCR6@^x~* zQ}+5n;yUy+QIh$I#HK3bD8u78Hz#;H!vuU5!!)TJ)^^F&iSA%Xny3}wY>D?NC^-@$W(;9XCRw2(|B%2sJs%h8Wy1q*siR1V4FZr4GefCn zTm+;+YI1}$%1X?Fu-IWQ86$c3hjymz06AT?8TzL;8C)Ho?-u4(?j8s?3(ph>`N0*X zIh2#-Vw|QdLJu}Z)t(t9{(Jo)tc(vVsOgoC=>ek!_r5GA6sFVxU{4Eof@~S&dTKp~ zYTLr~h|j0QBpC!{=BHUualL6K7yzQogfoorIW@MJ+&(u9R!m^&j8R^ZBs@(_4F8Fp zaqOA|pyH@>M}$~%zh;V2RmNUN)uh9W+Wrbq?4<@%+IWGzZeT2_q-<21t2Hm2pz+1+ z7RT@|@!8LZ64u1tMFA6S;jL(@%Ay)t_bQiO4s4Ghu2J&dmX};Bg{xu9*q9uz`M|Zq zY97VRaM-;`g+YJLu~hxmwe%wGp;A@CoEs_gvTu*3#)ZD9lecv1GoF#wBOl~v53dD3 zt=+aJ(DpxHYnkQHo-3_$kvA{rSW(_(f3bPBWsVrCA~F~hZc_|5li@2QnidHFa8>Xf!ok$LPYwhw|WQGwGFx)Cz;CI~UnT{x(YJq5Sg zmK)j3IZDbX5qagERuE54k}`2F{{%k#o+As?21RFNNQlUK_7n0MSNv&4|4MFLcoJE1 zYlaO&p2bQPr?J>ZPde*Hz_Nykts9VCm0qe55WrdfFlk9DI{#sN#W)TlzDSxf{5#dQ zBY)9%iLaD%(?;Evod@I@E|S2xdMRWJF~$H^m!_|d%%%p#ex@`uFwJhoQf8*dM7 z<9-dtYrC6#{KMGy&0|Z}3vK;=;t@jpsbkx2g15Mj;$m?WM@Qb30ak1<1}4Nuo}^D* z=9%ovLK1+0wCNVjo>19x7~MiHN*$ce2(=Gbz9#J|qVA76$n_U~J$C!7?gT-(nlr{d zs@6%<)b&&5j)M0q+x&O@BS#nd?U^f|;{$qo-b$O3Iu2gUZsmGgxgq#WUCNQV+eHJF zN5fy+U21XH*g>TxsrR+$5lQ%?)9SwMMe7xzE4pVWFAks9=*1ch+GrTwDzsNR>41nEB&NZ+4jZF6}%QE}gE%VPng0o#j5Q zrr$PhJ@)Op7opcAVO@QsLc+Rhs?ymAvs(>+9=bXc+enOZQ+_T8aSAD49RzDf5^psX z_d8B2qM}W2*{fC&6@}|;GB?|=lLZ}lS@|aKyRWAt4V+NodVi3-208y=*3+5mctj(} z%Pb8$5Z}Xd%$O}scB+{yXzOXG2FL2Xi|ob6XonIyY-8XFGNPz`-o-{=YE={8!ye&2@)$b|mj&a9r;6f5fA`yFLF1d4u zQKA{|Hz22i*@weLZm3yk!~};U<~7xFe+b7`v9xPu-e{YQYC880nWrPvfShqZ zefm!eJX94z_xm190Y*$IwHbB5Na3Ws=gfCP0et_!Fexrl8HEd$iNhbBkvK$h%Hn`i zaa_^9H?>v-B1cs3U1XaiY$*MCJRkboJD_c7AZ#fFTK(7%Z(_8Dxk!pvvi|M7;WOqS zl7rROT1bqfeRri&G^t`wd;+8a!Pq@fZjj-10;8r(4ueJ|>lVJD1uw_oC7Tw`zmFcS zYjeJwZ$`O%Q;%YLzL`aZ7H0rM;+EO46vv?kr3|$sCEA(kp|+6mXJVf({W5|=*Cm=#tWNZeD(A4@E|B2r1@{n+73ug$mFE&8l39UdWcf#fs|8Ym1#Nq!`lx9$7R)>b4) z#SBstP$L(N59@f-HIEmu6hK4gr3L0icKOv4qm)6rL-}M)X(}?ZvBks7S3qBL+&@TV z)dU95N=Wh%970&TFs^81E+nq166q7otKknJ!;d?xvT=$VvSr2%LTOH3Bz zHaC~EFZ^u;gcDNQA&y9dMl%>wt7Yg@o#HG+*ybB6Q;u>~IDs%I_bqUvqObAl(nL0F zv(bvMbVXduVE|?Z%w!X42n0>3{4LxZvQR|9F~&up+(ao1LWQZ{mg1=c1$;_D(YX`J zNH2983?6-d5@n%1kZez6jXcsBQag?HWlgfXsoLm-7BAc^?o(IliICtXWq>j)8B`-b zF_skbE|5W%CWQPX86?6yz{dKrS}Qbe1@x_rvSEOFFs zn)c<{5lH(q9?}U7C#>5j*G1pVZOiJS15vy%& z_PGI5I@~8{QYPZvLdSAQxwhpSSRd%3J~tbX?39FEOIep-vTk3h+0T&*M)=PpuR!|BJlm0c?G&_Y#~w4J)BJQhXl|pb$RnBO^rW|R4o#V-n3uDci8b}!wMV6VHbK3 zY5@_8&K0K=?uP)>+9n}zfRzj5e_q2#>5haNDETwWR7xumGs6luuFA9S+KbOk}G<*~@l#cLQ`G1(&v@eF zy`tXb>KOo^nn~QT=U-@x+Dc=u!|Y{`WTJ39WEndI8%LHRJO(sLs{}(oyqDrnP=Z1g;-^LI>(uPI|^;1x3`@dmnUM z19vk4DJ(u8a8JU+Bz|!aLsQahn6hlXFy>}G4e*1}>-Pn80?;$G zzyhI68pVHG6%Ab{bVSD>w9z{jeE05R-9I%2*m~Jpn z_*rh#fh%J4Jk4-do8d4a096x#2SjxG`OFxe7=r2UQgW)*XdZ zT8(hpu3J!siT{Trm%z5SRLk2dq*NIbplCw7ou|+Wsy0?cnat6E%;*@`u5VgLVCuNe zPXmL3%!RQuH~UHJD9?ee6ZFm)ieqi2%k7NojkqDk>j*8n1n~eS-mXrOL~rvGgspVQ z(89P=1>+v+v8BP`WS?LA!bfkFKqa2`vzHGO^B7WRoTRpvPzaVyJbc^JHR@Ut;a<^K z;Ylmx2*q)p87HK3B$KITF-Q_5XN~E{mB>13qR`A=g8ZIn1VmvYxFlWlhtTT;at)&n_(Z&zZ3Itcb8 zT|00#r(_G6Axm_R-e8Jg^olAk%x&W;;1W@CzgF+^gAY7iP59f-#{B&3FIAx>BX!^} zYg9oVwiCZGH1n8zT`?g*z5kWW%ds4lhK&XuUm2;_Gs*RTCjahrdYfa?YMPPpxfs zjoxSggXGp<{T^@uqc=~{i+6MJp3A)z#%fjihrYjTU^{75GBs~@oivb{wl}3hR$H74 z+|3#Tf5)*T?s6fsaDtaUAeoy>lQF?4_oIev(7F5hmIw`K;FQtXH2QO5vX|Iao^qw| z#W{Lx@+;mqlYmJ3b3W)xcUA)}&)sunt##Ph8mGVtsP8E&s z^RT!Bnr|xMe@C8mawnpS>ATe&0o0(FzexMt&<(nv_JJ0+#E4&#beQa*FF-?5Q@>+R zllL|jY5uz4`yQ_-R5g1&nidf3T%iNL0vu0Di8FwQf6~g_FXGwSM^cPOQ9Zs;V z?kD;mgf@#y4n<}t0030lzZSH?|FXsZ-(ks{+nD~zl3z?uCj0l*?0?W!|Bqsk%B;=W zx8E#zHFfTXaKi)u=;WW2u(;!@xxkue#gH7~gdqr~O+v!uU+*|Vxzg5}=J4XXM;ne+ z(>x(1OaN4lqINhpP%R+cJ&6?~nqv%(5t>C?jM%U;wpi8$)~wQ#GiN5CA5~X1kOhuN zyTsb%Y%HC|W^G$<3rp$gUf<5eI^>M}y>>x3Ivny;pt9qjJf?|MLbOAF_8261Al~L3 zy0Hy7(2TcTt$dQoa$prs&YHD2+XOoEJuLUPZo{$(EPvd0zSBCTs&49l<-MQ%oPxt`N`t~MB*eolSMq}vozb7dUY!OU7sT_0{U-`97zw7m$oH`0V> zbLER*AU-1&Fsm5C$-{7h(4C>GQ4l^#8U#TVr^67n3?Bass$PX?t9|0Twr61wiehNR8<5kd= zLpDsj=9EdH)}Ri?GZVrK30DJ6SeP{M@OI6X1BIwH=-YVRT1qj|qn!*V zV6qlPkE1Zg&(h-KGs_S0+i8ab&kx76JXECz$l`G3w+76V(+$K{1Q4nOE@|J z4>=YEnYn^bljNtoa^cEmP;OxuaQ<}aMsb+72tb(H3)7-wue?DNtg9AX8NF2${0*H1 zQJm!_ibCb^DV%;x_9wd=m7K4R9GFM*ZS#jAT2niv;-@_j#Beosf?FH4GH{j^oAbN* zpdxa<%k@u+UfAAMQzUH`Y|Zk`xvBeg>|JV{=_|40fXXV6I};@B^txwOT1KJ+*w>o? zo%9&vrAUNBLf^wSTXgCX( : -# Activate WOR -# assign : -# Assign the WOR -# clone : -# Clones a WOR -# comment -# Add a comment to the Notes_Entry field for the WOR -# complete : -# Complete WOR -# createhd: -# Create a new Help Desk Ticket -# createwor: -# Create a new WOR -# effort : -# Update the WOR's actual hours -# exit|quit: -# Exits cqtool -# help: -# This display -# link : -# Link a parent WOR to a child WOR -# resolve : -# Resolve WOR -# set -# Set to for the -# usage: -# Displays command line usage -# version: -# Displays version of cqtool -# -# Many of these commands simply perform actions on a wor. Two -# of these commands, createwor and createhd have Perl/Tk GUI -# interfaces. -# -# Command line usage: -# -# Usage: cqtool\t[-usage|help] [-verbose] [-debug] -# [-userid ] [-password ] [] -# -# Where: -# -# -usage|help: Display usage -# -verbose: Turn on verbose mode -# -debug: Turn on debug mode -# -userid: User ID to log into Clearquest database as -# -password: Password to use -# If specified then cqtool executes and -# exits -# -# Environment: cqtool supports the following environment variables -# that are used mostly for tesing purposes -# -# CQ_DBSET: Clearquest DBSET to open (e.g. XTST3 for testing - -# default RANCQ) -# CQ_USER: User name to log into the $CQ_DBSET database with -# CQ_PASSWORD: Password to use to log into the $CQ_DBSET with. -# -# Author: Andrew@DeFaria.com -# -# (c) Copyright 2007, General Dynamics, all rights reserved -# -############################################################################## -use strict; -use warnings; - -use CQPerlExt; -use FindBin; -use Getopt::Long; -use Term::ANSIColor qw (:constants); - -use lib ("$FindBin::Bin", "$FindBin::Bin/../lib"); - -use SCCM::Misc; -use Display; -use CQTool; -use CreateWORUI; -use CreateHelpDeskUI; -use Logger; - -my $VERSION = BOLD GREEN . "1.1" . RESET; -my $PROMPT = BOLD YELLOW . ">>" . RESET; -my $UCMWB_PROMPT = ">>"; -my $DESC = BOLD RED . "$FindBin::Script" . - RESET " Version " . - $VERSION . - CYAN ": Program to talk to Clearquest" . - RESET; - -# Globals -my $_userid = $ENV{CQ_USER} ? $ENV{CQ_USER} : $ENV{USER}; -my $_password = $ENV{CQ_PASSWORD}; -my $_db_name = $ENV{CQ_DBSET} ? $ENV{CQ_DBSET} : "RANCQ"; -my $_ucmwb; - -my $_log; - -if (get_debug) { - $_log = new Logger ( - path => "/tmp", - append => 1, - ); -} # if - -my %_commands = ( - activate => \&activate, - assign => \&assign, - clone => \&clone, - comment => \&comment, - complete => \&complete, - createhd => \&createHelpDesk, - createwor => \&createWOR, - effort => \&effort, - exit => \&shutdown, - help => \&help, - link => \&linkParentWor2ChildWor, - quit => \&shutdown, - resolve => \&resolve, - set => \&set, - usage => \&usage, - version => \&announce, -); - -############################################################################## -# Forwards -############################################################################## -sub commandLoop (@); - -############################################################################## -# Main -############################################################################## -MAIN: { - GetOptions ( - "usage" => sub { usage () }, - "verbose" => sub { set_verbose () }, - "debug" => sub { set_debug () }, - "userid=s" => \$_userid, - "password=s" => \$_password, - "database=s" => \$_db_name, - "ucmwb" => \$_ucmwb, - ) || usage (); - - exit (commandLoop(@ARGV)); -} # MAIN - -############################################################################## -# Subroutines -############################################################################## - -#----------------------------------------------------------------------------- -# shutdown (): Ends program -#----------------------------------------------------------------------------- -sub shutdown () { - exit (0); -} # exit - -#----------------------------------------------------------------------------- -# help (): Displays help -#----------------------------------------------------------------------------- -sub help () { - display ($DESC); - display < : - Activate WOR -assign : - Assign the WOR -clone : - Clones a WOR -comment - Add a comment to the Notes_Entry field for the WOR -complete : - Complete WOR -createhd: - Create a new Help Desk Ticket -createwor: - Create a new WOR -effort : - Update the WOR's actual hours -exit|quit: - Exits $FindBin::Script -help: - This display -link : - Link a parent WOR to a child WOR -resolve : - Resolve WOR -set - Set to for the -usage: - Displays command line usage -version: - Displays version of $FindBin::Script -END -} # help - -#----------------------------------------------------------------------------- -# announce (): Announce ourselves -#----------------------------------------------------------------------------- -sub announce () { - display ($DESC); -} # Announce - -#----------------------------------------------------------------------------- -# dberror ($): Handle errors when talking to Clearquest. Note we need to reset -# the database connection if an error happens. -#----------------------------------------------------------------------------- -sub dberror ($) { - my ($msg) = @_; - - # Need to not only report the error but to reopen the - # database. Something gets corruppted if we don't! - error ($msg); - - closeDB (); - - openDB ($_userid, $_password, $_db_name); -} # DBError - -#----------------------------------------------------------------------------- -# getEntity ($$): Get an entity from Clearquest -#----------------------------------------------------------------------------- -sub getEntity ($$) { - my ($recordname, $wor) = @_; - - my $entity; - - eval { - $entity = $CQTool::session->GetEntity ($recordname, $wor); - }; - - if ($@) { - chomp $@; - dberror ($@); - return undef; - } else { - return $entity; - } # if -} # getEntity - -#----------------------------------------------------------------------------- -# set ($$$): Set $field to $value for $wor -#----------------------------------------------------------------------------- -sub set ($$@) { - my ($wor, $field, $value) = @_; - - if (!$wor or $wor eq "") { - error ("WOR is required"); - return 1; - } # if - - if (!$field or $field eq "") { - error ("Field is required"); - return 1; - } # if - - my $entity = getEntity ("WOR", $wor); - - return 1 if !$entity; - - $session->EditEntity ($entity, "modify"); - - $_log->msg ("Modifying $field to \"$value\"") if get_debug; - eval { - $entity->SetFieldValue ($field, $value); - }; - - if ($@) { - dberror ("$field set failed for WOR $wor:\n$@"); - return 2; - } # if - - my $status = $entity->Validate (); - - if ($status ne "") { - $entity->Revert (); - error ("$field validate failed for WOR $wor:\n$status"); - return 2; - } # if - - $status = $entity->Commit (); - - if ($status ne "") { - error ("$field update failed during Submit for $wor:\n$status"); - return 2; - } # if - - return 0; -} # set - -#----------------------------------------------------------------------------- -# clone ($): Clone a WOR -#----------------------------------------------------------------------------- -sub clone ($) { - my ($wor) = @_; - - if (!$wor) { - error ("WOR not specified!"); - return 1; - } # if - - $entity = getEntity ("WOR", $wor); - - return 1 if !$entity; - - # Check state - my $state = $entity->GetFieldValue ("state")->GetValue (); - - if ($state ne "Closed") { - error ("WOR $wor not closed - Unable to clone!"); - return 1; - } # if - - verbose ("Cloning WOR $wor..."); - - my $result = 0; - - eval { - # Currently Clone doesn't return a proper result but eventually... - $result = $CQTool::session->FireRecordScriptAlias ($entity, "Clone"); - }; - - if ($@) { - chomp $@; - dberror ($@); - return 1; - } # if - - return $result; -} # clone - -#----------------------------------------------------------------------------- -# effort ($$): Update actual hours for a WOR -#----------------------------------------------------------------------------- -sub effort ($$) { - my ($wor, $actualHrs) = @_; - - return set $wor, "ActualEffort", $actualHrs; -} # effort - -#----------------------------------------------------------------------------- -# comment (): Update the Notes_Entry comment field for a WOR -#----------------------------------------------------------------------------- -sub comment ($) { - my ($wor) = @_; - - if (!$wor) { - error "WOR not defined in call to comment!"; - return 1; - } # if - - if (!$_ucmwb) { - display ("Enter comments below. When finished, enter \".\" on a line by itself or hit ^D:"); - } else { - # We still need to prompt for the comments however signal UCMWB - # that command is ready for more input. - display_nolf ($UCMWB_PROMPT); - } # if - - my $comments; - - while () { - last if $_ eq ".\n"; - $comments .= $_; - } # while - - chomp $comments; - - $_log->msg ("Comments:\n$comments") if get_debug; - - return set $wor, "Note_Entry", $comments; -} # Comment - -#----------------------------------------------------------------------------- -# linkParentWor2ChildWor ($$): Link a child WOR to a parent WOR -#----------------------------------------------------------------------------- -sub linkParentWor2ChildWor ($$) { - my ($parentWor, $childWor) = @_; - - my $status; - - verbose ("Linking $parentWor -> $childWor..."); - - my $childentity = getEntity ("WOR", $childWor); - my $parententity = getEntity ("WOR", $parentWor); - - return 1 unless $childentity and $parententity; - - $session->EditEntity ($parententity, "modify"); - - $parententity->AddFieldValue ("wor_children", $childWor); - - $status = $parententity->Validate (); - - if ($status ne "") { - $parententity->Revert (); - error ("Validation failed while attempting to add child WOR $childWor to parent WOR $parentWor:\n$status"); - return 1; - } # if - - eval { - $status = $parententity->Commit (); - }; - - $status = $@ if $@; - - if ($status ne "") { - (error "Commit failed while trying to add child WOR $childWor to parent WOR $parentWor:\n$status"); - return 2; - } # if - - debug "Modifying child $childWor..."; - $session->EditEntity ($childentity, "modify"); - - $childentity->SetFieldValue ("wor_parent", $parentWor); - - $status = $childentity->Validate (); - - if ($status ne "") { - $childentity->Revert (); - error "Validation failed while attempting to add parent WOR $parentWor to child WOR $childWor:\n$status"; - return 1; - } # if - - eval { - $status = $childentity->Commit (); - }; - - $status = $@ if $@; - - if ($status ne "") { - error "Commit failed while trying to add parent WOR $parentWor to child WOR $childWor:\n$status"; - return 2; - } # if - - return 0; -} # linkParentWor2ChildWor - -#----------------------------------------------------------------------------- -# assign ($$$$): Assign a WOR -#----------------------------------------------------------------------------- -sub assign ($$$$$) { - my ($wor, $assignee, $project, $plannedHrs, $startDate) = @_; - - if (!$wor or $wor eq "") { - error ("WOR is required"); - return 1; - } # if - - if (!$assignee or $assignee eq "") { - error ("Assignee must be specified"); - return 1; - } # if - - if (!$project or $project eq "") { - error ("UCM Project is required"); - return 1; - } # if - - if (!$startDate or $startDate eq "") { - error ("Planned Start Date is required"); - return 1; - } # if - - my $entity = getEntity ("WOR", $wor); - - return 1 if !$entity; - - my $state = $entity->GetFieldValue ("state")->GetValue (); - - if ($state ne "Submitted") { - error ("WOR $wor is not in Submitted state!\nState: $state"); - return 2; - } # if - - $session->EditEntity ($entity, "assign"); - - $entity->SetFieldValue ("ucm_project", $project) if $project ne ""; - $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne ""; - $entity->SetFieldValue ("PlannedEffort", $plannedHrs) if $plannedHrs ne ""; - $entity->SetFieldValue ("Owner", $assignee) if $assignee ne ""; - - my $status = $entity->Validate (); - - if ($status ne "") { - $entity->Revert (); - error ("Assign failed for WOR $wor:\n$status"); - return 2; - } # if - - $status = $entity->Commit (); - - if ($status ne "") { - error ("Assign failed during Submit for WOR $wor:\n$status"); - return 2; - } # if - - return 0; -} # assign - -#----------------------------------------------------------------------------- -# activate (): Activate a WOR -#----------------------------------------------------------------------------- -sub activate ($$$$$) { - my ($wor, $project, $estHrs, $startDate, $endDate) = @_; - - if (!$wor or $wor eq "") { - error ("WOR is required"); - return 1; - } # if - - if (!$project or $project eq "") { - error ("UCM Project is required"); - return 1; - } # if - - if (!$startDate or $startDate eq "") { - error ("Planned Start Date is required"); - return 1; - } # if - - if (!$endDate or $endDate eq "") { - error ("Planned End Date is required"); - return 1; - } # if - - my $entity = getEntity ("WOR", $wor); - - return 1 if !$entity; - - my $state = $entity->GetFieldValue ("state")->GetValue (); - - if ($state ne "Assessing") { - error ("WOR $wor is not in Assessing state!\nstate: $state"); - return 2; - } # if - - $session->EditEntity ($entity, "activate"); - - $entity->SetFieldValue ("ucm_project", $project) if $project ne ""; - $entity->SetFieldValue ("EstimatedEffort", $estHrs) if $estHrs ne ""; - $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne ""; - $entity->SetFieldValue ("PlannedEnd", $endDate) if $endDate ne ""; - - my $status = $entity->Validate (); - - if ($status ne "") { - $entity->Revert (); - error ("Activate failed for WOR $wor:\n$status"); - return 2; - } # if - - $status = $entity->Commit (); - - if ($status ne "") { - error ("Activate failed during Submit for WOR $wor:\n$status"); - return 2; - } # if - - return 0; -} # activate - -#----------------------------------------------------------------------------- -# resolve ($): Resolve a WOR -#----------------------------------------------------------------------------- -sub resolve ($) { - my ($wor) = @_; - - if (!$wor or $wor eq "") { - error ("WOR is required"); - return 1; - } # if - - my $entity = getEntity ("WOR", $wor); - - return 1 if !$entity; - - my $state = $entity->GetFieldValue ("state")->GetValue (); - - if ($state ne "Working") { - error ("WOR $wor is not in Working state!\nState: $state"); - return 2; - } # if - - $session->EditEntity ($entity, "resolve"); - - my $status = $entity->Validate (); - - if ($status ne "") { - $entity->Revert (); - error ("Resolve failed for WOR $wor:\n$status"); - return 2; - } # if - - $status = $entity->Commit (); - - if ($status ne "") { - error ("Resolve failed during Submit for WOR $wor:\n$status"); - return 2; - } # if - - return 0; -} # resolve - -#----------------------------------------------------------------------------- -# complete ($$): Complete a WOR -#----------------------------------------------------------------------------- -sub complete ($$) { - my ($wor, $actualHrs) = @_; - - if (!$wor or $wor eq "") { - error ("WOR is required"); - return 1; - } # if - - if (!$wor or $wor eq "") { - error ("Actual Hours are required"); - return 1; - } # if - - my $entity = getEntity ("WOR", $wor); - - return 1 if !$entity; - - my $state = $entity->GetFieldValue ("state")->GetValue (); - - if ($state ne "Verifying") { - error ("WOR $wor is not in Verifying state!\nState:$state"); - return 2; - } # if - - $session->EditEntity ($entity, "complete"); - $entity->SetFieldValue ("ActualEffort", $actualHrs) if $actualHrs ne ""; - - my $status = $entity->Validate (); - - if ($status ne "") { - $entity->Revert (); - error ("Complete failed for WOR $wor:\n$status"); - return 2; - } # if - - $status = $entity->Commit (); - - if ($status ne "") { - error ("Complete failed during Submit for WOR $wor:\n$status"); - return 2; - } # if - - return 0; -} # Complete - -#----------------------------------------------------------------------------- -# executeCommand (@): Executes a cqtool command -#----------------------------------------------------------------------------- -sub executeCommand (@) { - my (@args) = @_; - - my $cmd = lc shift @args; - - return if $cmd eq ""; - - if ($_commands{$cmd}) { - if (!$CQTool::session) { - if ( # Commands that do not require a database connection - !($cmd eq "exit" or - $cmd eq "quit" or - $cmd eq "help" or - $cmd eq "usage" or - $cmd eq "verbose")) { - verbose "Opening $_db_name as $_userid..."; - - if (!$_password) { - display_nolf ("${_userid}'s password:"); - `stty -echo`; - $_password = ; - chomp $_password; - display (""); - `stty echo`; - } # if - - openDB ($_userid, $_password, $_db_name); - } # if - } # if - - # Treat args: Args that are enclosed in quotes must be - # combined. For simplicity's sake we will only support matched - # pairs of double quotes. Anything else results in undefined - # behavior. - my (@new_args); - - foreach (@args) { - # Quoted argument starting - if (/^\"(.*)\"$/s) { - push @new_args, $1; - } else { - push @new_args, $_; - } # if - } # foreach - - $_log->msg ("$cmd (" . join (",", @new_args) . ")") if get_debug; - - return $_commands{$cmd} (@new_args); - } else { - error ("Unknown command \"$cmd\" (try help)"); - return 1; - } # if -} # executeCommand - -#----------------------------------------------------------------------------- -# commandLoop (@): This is the interactive command loop -#----------------------------------------------------------------------------- -sub commandLoop (@) { - my (@args) = @_; - - # For single, command line, commands... - return executeCommand (@args) if @args; - - announce if !$_ucmwb; - - while () { - if (!$_ucmwb) { - display_nolf ($PROMPT . RESET . UNDERLINE); - } else { - display_nolf ($UCMWB_PROMPT); - } # if - - # Read command into $_ - $_ = ; - chomp; - - # If we are not being called by ucmwb, display RESET to stop the - # UNDERLINE we were using. This keeps the output from being - # underlined. In ucmwb mode we are not using any of the terminal - # sequences. - display_nolf (RESET) if !$_ucmwb; - - # If the user hit Control-d then a ^D is displayed but we remain - # on the same line. So output a carriage return and exit 0. - if (!$_) { - display (""); - exit 0; - } # if - - # Special handling for set command since we want to take - # everything after to be a value, and we may get long - # values that are space separated and space significant - # (e.g. description?) - if (/^\s*(\w+)\s+(\w+)\s+(\w+)\s+(.*)/) { - if (lc $1 eq "set") { - my $cmd = $1; - my $wor = $2; - my $field = $3; - my $value = $4; - - # Change "\n"'s back to \n's - $value =~ s/\\n/\n/g; - - executeCommand ($cmd, $wor, $field, "\"$value\""); - } else { - executeCommand (split); - } # if - } else { - executeCommand (split); - } # if - } # while -} # commandLoop +#!/usr/bin/env /opt/rational/clearquest/bin/cqperl +############################################################################## +# +# Name: cqtool +# +# Description: cqtool is an interface to Clearquest to perform some simple +# actions to the RANCQ database. It is used primarily by ucmwb +# but it also supports a command line interface. +# +# The following commands are supported: +# +# activate : +# Activate WOR +# assign : +# Assign the WOR +# clone : +# Clones a WOR +# comment +# Add a comment to the Notes_Entry field for the WOR +# complete : +# Complete WOR +# createhd: +# Create a new Help Desk Ticket +# createwor: +# Create a new WOR +# effort : +# Update the WOR's actual hours +# exit|quit: +# Exits cqtool +# help: +# This display +# link : +# Link a parent WOR to a child WOR +# resolve : +# Resolve WOR +# set +# Set to for the +# usage: +# Displays command line usage +# version: +# Displays version of cqtool +# +# Many of these commands simply perform actions on a wor. Two +# of these commands, createwor and createhd have Perl/Tk GUI +# interfaces. +# +# Command line usage: +# +# Usage: cqtool\t[-usage|help] [-verbose] [-debug] +# [-userid ] [-password ] [] +# +# Where: +# +# -usage|help: Display usage +# -verbose: Turn on verbose mode +# -debug: Turn on debug mode +# -userid: User ID to log into Clearquest database as +# -password: Password to use +# If specified then cqtool executes and +# exits +# +# Environment: cqtool supports the following environment variables +# that are used mostly for tesing purposes +# +# CQ_DBSET: Clearquest DBSET to open (e.g. XTST3 for testing - +# default RANCQ) +# CQ_USER: User name to log into the $CQ_DBSET database with +# CQ_PASSWORD: Password to use to log into the $CQ_DBSET with. +# +# Author: Andrew@DeFaria.com +# +# (c) Copyright 2007, General Dynamics, all rights reserved +# +############################################################################## +use strict; +use warnings; + +use CQPerlExt; +use FindBin; +use Getopt::Long; +use Term::ANSIColor qw (:constants); + +use lib ("$FindBin::Bin", "$FindBin::Bin/../lib"); + +use SCCM::Misc; +use Display; +use CQTool; +use CreateWORUI; +use CreateHelpDeskUI; +use Logger; + +my $VERSION = BOLD GREEN . "1.1" . RESET; +my $PROMPT = BOLD YELLOW . ">>" . RESET; +my $UCMWB_PROMPT = ">>"; +my $DESC = BOLD RED . "$FindBin::Script" . + RESET " Version " . + $VERSION . + CYAN ": Program to talk to Clearquest" . + RESET; + +# Globals +my $_userid = $ENV{CQ_USER} ? $ENV{CQ_USER} : $ENV{USER}; +my $_password = $ENV{CQ_PASSWORD}; +my $_db_name = $ENV{CQ_DBSET} ? $ENV{CQ_DBSET} : "RANCQ"; +my $_ucmwb; + +my $_log; + +if (get_debug) { + $_log = new Logger ( + path => "/tmp", + append => 1, + ); +} # if + +my %_commands = ( + activate => \&activate, + assign => \&assign, + clone => \&clone, + comment => \&comment, + complete => \&complete, + createhd => \&createHelpDesk, + createwor => \&createWOR, + effort => \&effort, + exit => \&shutdown, + help => \&help, + link => \&linkParentWor2ChildWor, + quit => \&shutdown, + resolve => \&resolve, + set => \&set, + usage => \&usage, + version => \&announce, +); + +############################################################################## +# Forwards +############################################################################## +sub commandLoop (@); + +############################################################################## +# Main +############################################################################## +MAIN: { + GetOptions ( + "usage" => sub { usage () }, + "verbose" => sub { set_verbose () }, + "debug" => sub { set_debug () }, + "userid=s" => \$_userid, + "password=s" => \$_password, + "database=s" => \$_db_name, + "ucmwb" => \$_ucmwb, + ) || usage (); + + exit (commandLoop(@ARGV)); +} # MAIN + +############################################################################## +# Subroutines +############################################################################## + +#----------------------------------------------------------------------------- +# shutdown (): Ends program +#----------------------------------------------------------------------------- +sub shutdown () { + exit (0); +} # exit + +#----------------------------------------------------------------------------- +# help (): Displays help +#----------------------------------------------------------------------------- +sub help () { + display ($DESC); + display < : + Activate WOR +assign : + Assign the WOR +clone : + Clones a WOR +comment + Add a comment to the Notes_Entry field for the WOR +complete : + Complete WOR +createhd: + Create a new Help Desk Ticket +createwor: + Create a new WOR +effort : + Update the WOR's actual hours +exit|quit: + Exits $FindBin::Script +help: + This display +link : + Link a parent WOR to a child WOR +resolve : + Resolve WOR +set + Set to for the +usage: + Displays command line usage +version: + Displays version of $FindBin::Script +END +} # help + +#----------------------------------------------------------------------------- +# announce (): Announce ourselves +#----------------------------------------------------------------------------- +sub announce () { + display ($DESC); +} # Announce + +#----------------------------------------------------------------------------- +# dberror ($): Handle errors when talking to Clearquest. Note we need to reset +# the database connection if an error happens. +#----------------------------------------------------------------------------- +sub dberror ($) { + my ($msg) = @_; + + # Need to not only report the error but to reopen the + # database. Something gets corruppted if we don't! + error ($msg); + + closeDB (); + + openDB ($_userid, $_password, $_db_name); +} # DBError + +#----------------------------------------------------------------------------- +# getEntity ($$): Get an entity from Clearquest +#----------------------------------------------------------------------------- +sub getEntity ($$) { + my ($recordname, $wor) = @_; + + my $entity; + + eval { + $entity = $CQTool::session->GetEntity ($recordname, $wor); + }; + + if ($@) { + chomp $@; + dberror ($@); + return undef; + } else { + return $entity; + } # if +} # getEntity + +#----------------------------------------------------------------------------- +# set ($$$): Set $field to $value for $wor +#----------------------------------------------------------------------------- +sub set ($$@) { + my ($wor, $field, $value) = @_; + + if (!$wor or $wor eq "") { + error ("WOR is required"); + return 1; + } # if + + if (!$field or $field eq "") { + error ("Field is required"); + return 1; + } # if + + my $entity = getEntity ("WOR", $wor); + + return 1 if !$entity; + + $session->EditEntity ($entity, "modify"); + + $_log->msg ("Modifying $field to \"$value\"") if get_debug; + eval { + $entity->SetFieldValue ($field, $value); + }; + + if ($@) { + dberror ("$field set failed for WOR $wor:\n$@"); + return 2; + } # if + + my $status = $entity->Validate (); + + if ($status ne "") { + $entity->Revert (); + error ("$field validate failed for WOR $wor:\n$status"); + return 2; + } # if + + $status = $entity->Commit (); + + if ($status ne "") { + error ("$field update failed during Submit for $wor:\n$status"); + return 2; + } # if + + return 0; +} # set + +#----------------------------------------------------------------------------- +# clone ($): Clone a WOR +#----------------------------------------------------------------------------- +sub clone ($) { + my ($wor) = @_; + + if (!$wor) { + error ("WOR not specified!"); + return 1; + } # if + + $entity = getEntity ("WOR", $wor); + + return 1 if !$entity; + + # Check state + my $state = $entity->GetFieldValue ("state")->GetValue (); + + if ($state ne "Closed") { + error ("WOR $wor not closed - Unable to clone!"); + return 1; + } # if + + verbose ("Cloning WOR $wor..."); + + my $result = 0; + + eval { + # Currently Clone doesn't return a proper result but eventually... + $result = $CQTool::session->FireRecordScriptAlias ($entity, "Clone"); + }; + + if ($@) { + chomp $@; + dberror ($@); + return 1; + } # if + + return $result; +} # clone + +#----------------------------------------------------------------------------- +# effort ($$): Update actual hours for a WOR +#----------------------------------------------------------------------------- +sub effort ($$) { + my ($wor, $actualHrs) = @_; + + return set $wor, "ActualEffort", $actualHrs; +} # effort + +#----------------------------------------------------------------------------- +# comment (): Update the Notes_Entry comment field for a WOR +#----------------------------------------------------------------------------- +sub comment ($) { + my ($wor) = @_; + + if (!$wor) { + error "WOR not defined in call to comment!"; + return 1; + } # if + + if (!$_ucmwb) { + display ("Enter comments below. When finished, enter \".\" on a line by itself or hit ^D:"); + } else { + # We still need to prompt for the comments however signal UCMWB + # that command is ready for more input. + display_nolf ($UCMWB_PROMPT); + } # if + + my $comments; + + while () { + last if $_ eq ".\n"; + $comments .= $_; + } # while + + chomp $comments; + + $_log->msg ("Comments:\n$comments") if get_debug; + + return set $wor, "Note_Entry", $comments; +} # Comment + +#----------------------------------------------------------------------------- +# linkParentWor2ChildWor ($$): Link a child WOR to a parent WOR +#----------------------------------------------------------------------------- +sub linkParentWor2ChildWor ($$) { + my ($parentWor, $childWor) = @_; + + my $status; + + verbose ("Linking $parentWor -> $childWor..."); + + my $childentity = getEntity ("WOR", $childWor); + my $parententity = getEntity ("WOR", $parentWor); + + return 1 unless $childentity and $parententity; + + $session->EditEntity ($parententity, "modify"); + + $parententity->AddFieldValue ("wor_children", $childWor); + + $status = $parententity->Validate (); + + if ($status ne "") { + $parententity->Revert (); + error ("Validation failed while attempting to add child WOR $childWor to parent WOR $parentWor:\n$status"); + return 1; + } # if + + eval { + $status = $parententity->Commit (); + }; + + $status = $@ if $@; + + if ($status ne "") { + (error "Commit failed while trying to add child WOR $childWor to parent WOR $parentWor:\n$status"); + return 2; + } # if + + debug "Modifying child $childWor..."; + $session->EditEntity ($childentity, "modify"); + + $childentity->SetFieldValue ("wor_parent", $parentWor); + + $status = $childentity->Validate (); + + if ($status ne "") { + $childentity->Revert (); + error "Validation failed while attempting to add parent WOR $parentWor to child WOR $childWor:\n$status"; + return 1; + } # if + + eval { + $status = $childentity->Commit (); + }; + + $status = $@ if $@; + + if ($status ne "") { + error "Commit failed while trying to add parent WOR $parentWor to child WOR $childWor:\n$status"; + return 2; + } # if + + return 0; +} # linkParentWor2ChildWor + +#----------------------------------------------------------------------------- +# assign ($$$$): Assign a WOR +#----------------------------------------------------------------------------- +sub assign ($$$$$) { + my ($wor, $assignee, $project, $plannedHrs, $startDate) = @_; + + if (!$wor or $wor eq "") { + error ("WOR is required"); + return 1; + } # if + + if (!$assignee or $assignee eq "") { + error ("Assignee must be specified"); + return 1; + } # if + + if (!$project or $project eq "") { + error ("UCM Project is required"); + return 1; + } # if + + if (!$startDate or $startDate eq "") { + error ("Planned Start Date is required"); + return 1; + } # if + + my $entity = getEntity ("WOR", $wor); + + return 1 if !$entity; + + my $state = $entity->GetFieldValue ("state")->GetValue (); + + if ($state ne "Submitted") { + error ("WOR $wor is not in Submitted state!\nState: $state"); + return 2; + } # if + + $session->EditEntity ($entity, "assign"); + + $entity->SetFieldValue ("ucm_project", $project) if $project ne ""; + $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne ""; + $entity->SetFieldValue ("PlannedEffort", $plannedHrs) if $plannedHrs ne ""; + $entity->SetFieldValue ("Owner", $assignee) if $assignee ne ""; + + my $status = $entity->Validate (); + + if ($status ne "") { + $entity->Revert (); + error ("Assign failed for WOR $wor:\n$status"); + return 2; + } # if + + $status = $entity->Commit (); + + if ($status ne "") { + error ("Assign failed during Submit for WOR $wor:\n$status"); + return 2; + } # if + + return 0; +} # assign + +#----------------------------------------------------------------------------- +# activate (): Activate a WOR +#----------------------------------------------------------------------------- +sub activate ($$$$$) { + my ($wor, $project, $estHrs, $startDate, $endDate) = @_; + + if (!$wor or $wor eq "") { + error ("WOR is required"); + return 1; + } # if + + if (!$project or $project eq "") { + error ("UCM Project is required"); + return 1; + } # if + + if (!$startDate or $startDate eq "") { + error ("Planned Start Date is required"); + return 1; + } # if + + if (!$endDate or $endDate eq "") { + error ("Planned End Date is required"); + return 1; + } # if + + my $entity = getEntity ("WOR", $wor); + + return 1 if !$entity; + + my $state = $entity->GetFieldValue ("state")->GetValue (); + + if ($state ne "Assessing") { + error ("WOR $wor is not in Assessing state!\nstate: $state"); + return 2; + } # if + + $session->EditEntity ($entity, "activate"); + + $entity->SetFieldValue ("ucm_project", $project) if $project ne ""; + $entity->SetFieldValue ("EstimatedEffort", $estHrs) if $estHrs ne ""; + $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne ""; + $entity->SetFieldValue ("PlannedEnd", $endDate) if $endDate ne ""; + + my $status = $entity->Validate (); + + if ($status ne "") { + $entity->Revert (); + error ("Activate failed for WOR $wor:\n$status"); + return 2; + } # if + + $status = $entity->Commit (); + + if ($status ne "") { + error ("Activate failed during Submit for WOR $wor:\n$status"); + return 2; + } # if + + return 0; +} # activate + +#----------------------------------------------------------------------------- +# resolve ($): Resolve a WOR +#----------------------------------------------------------------------------- +sub resolve ($) { + my ($wor) = @_; + + if (!$wor or $wor eq "") { + error ("WOR is required"); + return 1; + } # if + + my $entity = getEntity ("WOR", $wor); + + return 1 if !$entity; + + my $state = $entity->GetFieldValue ("state")->GetValue (); + + if ($state ne "Working") { + error ("WOR $wor is not in Working state!\nState: $state"); + return 2; + } # if + + $session->EditEntity ($entity, "resolve"); + + my $status = $entity->Validate (); + + if ($status ne "") { + $entity->Revert (); + error ("Resolve failed for WOR $wor:\n$status"); + return 2; + } # if + + $status = $entity->Commit (); + + if ($status ne "") { + error ("Resolve failed during Submit for WOR $wor:\n$status"); + return 2; + } # if + + return 0; +} # resolve + +#----------------------------------------------------------------------------- +# complete ($$): Complete a WOR +#----------------------------------------------------------------------------- +sub complete ($$) { + my ($wor, $actualHrs) = @_; + + if (!$wor or $wor eq "") { + error ("WOR is required"); + return 1; + } # if + + if (!$wor or $wor eq "") { + error ("Actual Hours are required"); + return 1; + } # if + + my $entity = getEntity ("WOR", $wor); + + return 1 if !$entity; + + my $state = $entity->GetFieldValue ("state")->GetValue (); + + if ($state ne "Verifying") { + error ("WOR $wor is not in Verifying state!\nState:$state"); + return 2; + } # if + + $session->EditEntity ($entity, "complete"); + $entity->SetFieldValue ("ActualEffort", $actualHrs) if $actualHrs ne ""; + + my $status = $entity->Validate (); + + if ($status ne "") { + $entity->Revert (); + error ("Complete failed for WOR $wor:\n$status"); + return 2; + } # if + + $status = $entity->Commit (); + + if ($status ne "") { + error ("Complete failed during Submit for WOR $wor:\n$status"); + return 2; + } # if + + return 0; +} # Complete + +#----------------------------------------------------------------------------- +# executeCommand (@): Executes a cqtool command +#----------------------------------------------------------------------------- +sub executeCommand (@) { + my (@args) = @_; + + my $cmd = lc shift @args; + + return if $cmd eq ""; + + if ($_commands{$cmd}) { + if (!$CQTool::session) { + if ( # Commands that do not require a database connection + !($cmd eq "exit" or + $cmd eq "quit" or + $cmd eq "help" or + $cmd eq "usage" or + $cmd eq "verbose")) { + verbose "Opening $_db_name as $_userid..."; + + if (!$_password) { + display_nolf ("${_userid}'s password:"); + `stty -echo`; + $_password = ; + chomp $_password; + display (""); + `stty echo`; + } # if + + openDB ($_userid, $_password, $_db_name); + } # if + } # if + + # Treat args: Args that are enclosed in quotes must be + # combined. For simplicity's sake we will only support matched + # pairs of double quotes. Anything else results in undefined + # behavior. + my (@new_args); + + foreach (@args) { + # Quoted argument starting + if (/^\"(.*)\"$/s) { + push @new_args, $1; + } else { + push @new_args, $_; + } # if + } # foreach + + $_log->msg ("$cmd (" . join (",", @new_args) . ")") if get_debug; + + return $_commands{$cmd} (@new_args); + } else { + error ("Unknown command \"$cmd\" (try help)"); + return 1; + } # if +} # executeCommand + +#----------------------------------------------------------------------------- +# commandLoop (@): This is the interactive command loop +#----------------------------------------------------------------------------- +sub commandLoop (@) { + my (@args) = @_; + + # For single, command line, commands... + return executeCommand (@args) if @args; + + announce if !$_ucmwb; + + while () { + if (!$_ucmwb) { + display_nolf ($PROMPT . RESET . UNDERLINE); + } else { + display_nolf ($UCMWB_PROMPT); + } # if + + # Read command into $_ + $_ = ; + chomp; + + # If we are not being called by ucmwb, display RESET to stop the + # UNDERLINE we were using. This keeps the output from being + # underlined. In ucmwb mode we are not using any of the terminal + # sequences. + display_nolf (RESET) if !$_ucmwb; + + # If the user hit Control-d then a ^D is displayed but we remain + # on the same line. So output a carriage return and exit 0. + if (!$_) { + display (""); + exit 0; + } # if + + # Special handling for set command since we want to take + # everything after to be a value, and we may get long + # values that are space separated and space significant + # (e.g. description?) + if (/^\s*(\w+)\s+(\w+)\s+(\w+)\s+(.*)/) { + if (lc $1 eq "set") { + my $cmd = $1; + my $wor = $2; + my $field = $3; + my $value = $4; + + # Change "\n"'s back to \n's + $value =~ s/\\n/\n/g; + + executeCommand ($cmd, $wor, $field, "\"$value\""); + } else { + executeCommand (split); + } # if + } else { + executeCommand (split); + } # if + } # while +} # commandLoop diff --git a/data/allmach b/data/allmach new file mode 100755 index 0000000..1e408cb --- /dev/null +++ b/data/allmach @@ -0,0 +1,44 @@ +################################################################################ +# +# File: machines +# Description: Defintion of machines for allmach +# Author: Andrew@DeFaria.com +# +################################################################################ +# Column 1 Machine name +# Column 2 Model +# Column 3 OS Version +# Column 4 ClearCase Version (if applicable) +# Column 5 Owner (if known) +# Column 6 Usage (if known) +cowboys:Sun:Solaris 5.9:7.0.1.0:ccadm:ranvob1/registry server +patriots:Sun:?:Solaris 5.9:7.0.1.0:ccadm:ranvob2 +rams:Sun:Solaris 5.9:7.0.1.0:ccadm:ranvob3/registry server +chargers:Sun:Solaris 5.9:70.1.1:ccadm:ranview1 +colts:Sun:Solaris 5.9:7.0.1.0:ccadm:ranview2 +ranbuild1:Sun:Solaris 5.8:7.0.1.0:ccadm:builds +ranbuild2:Sun:Solaris 5.9:2003.06.10+:ccadm:builds +ranbuild4:Sun:Solaris 5.9:7.0.1.1:ccadm:builds +randws119:Sun:Solaris 5.9:7.0.1.1:Hy Truong:Workstation +randws094:Sun:Solaris 5.10:7.0.1.1:John Hartin:Old workstation +randws033:Sun:Solaris 5.10:Sam Schwalm:Workstation +randws103:Sun:Solaris 5.9:7.0.1.1:?:? +randws106:Sun:Solaris 5.9:2003.06.10+:?:? +randws113:Sun:Solaris 5.9:7.0.1.1:?:? +randws114:Sun:Solaris 5.9:2003.06.10+:Tony Trujilo:? +randws000:Sun:Solaris 5.10:7.0.1.1:?:? +randws021:?:?:?:?:? +randws035:?:?:?:ccadm:? +randws036:?:?:?:ccadm:? +ranadm1:Sun:Solaris 5.9:?:ccadm:Jumpstart, PowerBroker, NIS, SMTP, DNS, NTP +ranadm2:Sun:Solaris 5.9:2003.06.10+:ccadm:License server, Sys admin, NIS, Home Directory server +ranray:Sun:Solaris 5.9:2003.06.10+:ccadm:? +ranray16:?:?:?:ccadm:Thin client to ranray +niners:Sun:Solaris 5.9:2003.06.10+:ccadm:? +randbs:Sun:Solaris 5.9:?:ccadm:CQ DB server/Bldforge +ranbkp2:?:?:?:ccadm:? +ranlin03:Redhat Linux:2.4.21-50.Elsmp:?:ccadm:? +rancpp10:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:? +rancpp01:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:? +rancpp02:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:? +rancpp03:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:? diff --git a/data/machines b/data/machines new file mode 100644 index 0000000..7d9873e --- /dev/null +++ b/data/machines @@ -0,0 +1,38 @@ +################################################################################ +# +# File: machines +# Description: Defintion of machines for allmach +# Author: Andrew@DeFaria.com +# +################################################################################ +# Column 1 Machine name +# Column 2 Model +# Column 3 OS Version +# Column 4 ClearCase Version (if applicable) +# Column 5 Owner (if known) +# Column 6 Usage (if known) +chargers:Sun:Solaris 5.9:70.1.1:ccadm:ranview1 +colts:Sun:Solaris 5.9:7.0.1.0:ccadm:ranview2 +cowboys:Sun:Solaris 5.9:7.0.1.0:ccadm:ranvob1/registry server +niners:Sun:Solaris 5.9:2003.06.10+:ccadm:? +patriots:Sun:?:Solaris 5.9:7.0.1.0:ccadm:ranvob2 +rams:Sun:Solaris 5.9:7.0.1.0:ccadm:ranvob3/registry server +#ranadm1:Sun:Solaris 5.9:?:ccadm:Jumpstart, PowerBroker, NIS, SMTP, DNS, NTP +ranadm2:Sun:Solaris 5.9:2003.06.10+:ccadm:License server, Sys admin, NIS, Home Directory server +ranbkp2:?:?:?:ccadm:? +ranbuild1:Sun:Solaris 5.8:7.0.1.0:ccadm:builds +ranbuild2:Sun:Solaris 5.9:2003.06.10+:ccadm:builds +ranbuild4:Sun:Solaris 5.9:7.0.1.1:ccadm:builds +rancpp01:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:? +rancpp02:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:? +rancpp03:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:? +rancpp10:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:? +#randbs:Sun:Solaris 5.9:?:ccadm:CQ DB server/Bldforge +randws094:Sun:Solaris 5.10:7.0.1.1:John Hartin:Old workstation +randws103:Sun:Solaris 5.9:7.0.1.1:?:? +randws106:Sun:Solaris 5.9:2003.06.10+:?:? +randws113:Sun:Solaris 5.9:7.0.1.1:?:? +randws114:Sun:Solaris 5.9:2003.06.10+:Tony Trujilo:? +randws119:Sun:Solaris 5.9:7.0.1.1:Hy Truong:Workstation +ranlin03:Redhat Linux:2.4.21-50.Elsmp:?:ccadm:? +ranray:Sun:Solaris 5.9:2003.06.10+:ccadm:? diff --git a/data/windows b/data/windows new file mode 100644 index 0000000..27250ae --- /dev/null +++ b/data/windows @@ -0,0 +1,24 @@ +################################################################################ +# +# File: windows +# Description: Defintion of machines for allmach +# Author: Andrew@DeFaria.com +# +################################################################################ +# Column 1 Machine name +# Column 2 Model +# Column 3 OS Version +# Column 4 ClearCase Version (if applicable) +# Column 5 Owner (if known) +# Column 6 Usage (if known) +ranframe06:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker +ranframe07:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker +ranframe09:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker/Buildforge Console +ranframe12:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker +ranframe14:Microsoft:Windows Server 2003:7.0.1.7:ccadm:Frame Maker +ranframe15:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker +ranframe16:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker +ranframe17:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker +ranframe18:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker +ranframe19:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker +ranframe20:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker diff --git a/lib/Clearcase.pm b/lib/Clearcase.pm index bb2b745..651d33c 100644 --- a/lib/Clearcase.pm +++ b/lib/Clearcase.pm @@ -87,10 +87,10 @@ our $VOB_MOUNT = 'vob'; our $WIN_VOB_PREFIX = '\\'; our $SFX = $ENV{CLEARCASE_XN_SFX} ? $ENV{CLEARCASE_XN_SFX} : '@@'; -our $VOBTAG_PREFIX = ($ARCH eq 'windows' or $ARCH eq 'cygwin') +our $VOBTAG_PREFIX = ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin') ? $WIN_VOB_PREFIX - : "/$VOB_MOUNT/"; -our $VIEWTAG_PREFIX = ($ARCH eq 'windows' or $ARCH eq 'cygwin') + : "/$VOB_MOUNT"; +our $VIEWTAG_PREFIX = ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin') ? "$VIEW_DRIVE:" : "${SEPARATOR}view"; @@ -112,15 +112,15 @@ our @EXPORT_OK = qw ( BEGIN { # Find executables that we rely on - if ($ARCH eq 'windows' or $ARCH eq 'cygwin') { + if ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin') { # Should really go to the registry for this... # We can go to the registry pretty easy in Cygwin but I'm not sure how to do # that in plain old Windows. Most people either have Clearcase installed on # the C drive or commonly on the D drive on servers. So we'll look at both. - $CCHOME = 'C:\\Program Files\\Rational\\Clearcase'; + $CCHOME = 'C:\\IBMRational\\RationalSDLC\\Clearcase'; - $CCHOME = 'D:\\Program Files\\Rational\\Clearcase' + $CCHOME = 'D:\\IBMRational\\RationalSDLC\\Clearcase' unless -d $CCHOME; error 'Unable to figure out where Clearcase is installed', 1 @@ -177,7 +177,7 @@ sub _formatOpts { sub _setComment ($) { my ($comment) = @_; - return !$comment ? '-nc' : '-c "' . quotameta $comment . '"'; + return !$comment ? '-nc' : '-c "' . quotemeta $comment . '"'; } # _setComment sub vobname ($) { @@ -238,7 +238,7 @@ The unique part of the vob name if (substr ($tag, 0, 1) eq '\\') { $name = substr $tag, 1; } elsif (substr ($tag, 0, 1) eq '/') { - if ($tag =~ /${Clearcase::VOBTAG_PREFIX}(.+)/) { + if ($tag =~ /${Clearcase::VOBTAG_PREFIX}\/(.+)/) { $name = $1; } # if } # if @@ -580,7 +580,7 @@ Array of output lines from the cleartool command execution. # run as a plain user who does not have cleartool in their path. my $cleartool; - if ($ARCH =~ /Win/ or $ARCH eq 'cygwin') { + if ($ARCHITECTURE =~ /Win/ or $ARCHITECTURE eq 'cygwin') { $cleartool = 'cleartool'; } elsif (-x '/opt/rational/clearcase/bin/cleartool') { $cleartool = '/opt/rational/clearcase/bin/cleartool'; @@ -627,12 +627,53 @@ Array of output lines from the cleartool command execution. pop @output if @output and $output[$#output] eq ''; - $self->{status} = $status; - $self->{output} = join "\n", @output; + $self->{lastcmd} = 'cleartool ' . $cmd; + $self->{status} = $status; + $self->{output} = join "\n", @output; return ($status, @output); } # execute +sub lastcmd() { + my ($self) = @_; + +=pod + +=head2 lastcmd() + +Return last command attempted by execute + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item Last command attempted by execute + +=back + +=for html
+ +=cut + + $self->{lastcmd} ||= ''; + + return $self->{lastcmd}; +} # lastcmd + sub new { my ($class) = @_; diff --git a/lib/Clearcase/UCM/Activity.pm b/lib/Clearcase/UCM/Activity.pm index 8c173c0..bc2e985 100644 --- a/lib/Clearcase/UCM/Activity.pm +++ b/lib/Clearcase/UCM/Activity.pm @@ -34,10 +34,10 @@ Provides access to information about Clearcase Activites. my @changeset = $activity->changeset; - foreach my $element (@changeset) { + for my $element (@changeset) { display "Element name: " . $element->pname; display "Element verison: " . $element->version; - } # foreach + } # for =head1 DESCRIPTION @@ -54,29 +54,24 @@ package Clearcase::UCM::Activity; use strict; use warnings; -use lib '../..'; - -use Clearcase; -use Clearcase::Element; - # We should really inherit these from a more generic super class... -sub _processOpts (%) { +sub _processOpts(%) { my ($self, %opts) = @_; my $opts; - foreach (keys %opts) { + for (keys %opts) { if ($_ eq 'cq' or $_ eq 'cqe' or $_ eq 'force' or $_ eq 'nc') { $opts .= "-$_ "; } elsif ($_ eq 'c' or $_ eq 'cfile') { $opts .= "-$_ $opts{$_}"; } # if - } # foreach + } # for return $opts; } # _processOpts -sub new ($$) { +sub new($$) { my ($class, $activity, $pvob) = @_; =pod @@ -113,16 +108,16 @@ Returns: =cut - my $self = bless { + $class = bless { name => $activity, - pvob => Clearcase::vobtag ($pvob), + pvob => $pvob, type => $activity =~ /^(deliver|rebase)./ ? 'integration' : 'regular', }, $class; # bless - return $self; + return $class; } # new -sub name () { +sub name() { my ($self) = @_; =pod @@ -160,7 +155,7 @@ Returns: return $self->{name}; } # name -sub pvob () { +sub pvob() { my ($self) = @_; =pod @@ -198,7 +193,7 @@ Returns: return $self->{pvob}; } # pvob -sub type () { +sub type() { my ($self) = @_; =pod @@ -236,7 +231,7 @@ Returns: return $self->{type}; } # type -sub contrib_acts () { +sub contrib_acts() { my ($self) = @_; =pod @@ -271,12 +266,12 @@ Returns: =cut - $self->updateActivityInfo () unless $self->{contrib_acts}; + $self->updateActivityInfo() unless $self->{contrib_acts}; return $self->{contrib_acts}; } # crm_record -sub crm_record_id () { +sub crm_record_id() { my ($self) = @_; =pod @@ -311,12 +306,12 @@ Returns: =cut - $self->updateActivityInfo () unless $self->{crm_record_id}; + $self->updateActivityInfo() unless $self->{crm_record_id}; return $self->{crm_record_id}; } # crm_record_id -sub crm_record_type () { +sub crm_record_type() { my ($self) = @_; =pod @@ -351,12 +346,12 @@ Returns: =cut - $self->updateActivityInfo () unless $self->{crm_record_type}; + $self->updateActivityInfo() unless $self->{crm_record_type}; return $self->{crm_record_type}; } # crm_record_type -sub crm_state () { +sub crm_state() { my ($self) = @_; =pod @@ -391,12 +386,12 @@ Returns: =cut - $self->updateActivityInfo () unless $self->{crm_state}; + $self->updateActivityInfo() unless $self->{crm_state}; return $self->{crm_state}; } # crm_state -sub headline () { +sub headline() { my ($self) = @_; =pod @@ -431,12 +426,12 @@ Returns: =cut - $self->updateActivityInfo () unless $self->{headline}; + $self->updateActivityInfo() unless $self->{headline}; return $self->{headline}; } # headline -sub name_resolver_view () { +sub name_resolver_view() { my ($self) = @_; =pod @@ -471,12 +466,12 @@ Returns: =cut - $self->updateActivityInfo () unless $self->{name_resolver_view}; + $self->updateActivityInfo() unless $self->{name_resolver_view}; return $self->{name_resolver_view}; } # name_resolver_view -sub stream () { +sub stream() { my ($self) = @_; =pod @@ -511,12 +506,12 @@ Returns: =cut - $self->updateActivityInfo () unless $self->{stream}; + $self->updateActivityInfo() unless $self->{stream}; return $self->{stream}; } # stream -sub changeset (;$) { +sub changeset(;$) { my ($self, $recalc) = @_; =pod @@ -559,7 +554,7 @@ Returns: my $cmd = "lsact -fmt \"%[versions]CQp\" $self->{name}\@$pvob"; - my ($status, @output) = $Clearcase::CC->execute ($cmd); + my ($status, @output) = $Clearcase::CC->execute($cmd); return ($status, @output) if $status; @@ -581,7 +576,7 @@ Returns: @output = split /\", \"/, $output[0] if $output[0]; - foreach (@output) { + for (@output) { # Skip any cleartool warnings. We are getting warnings of the form: # "A version in the change set of activity "63332.4" is currently # unavailable". Probably some sort of subtle corruption that we can ignore. @@ -613,18 +608,28 @@ Returns: # Additionally we will set into the $element object the extended name. This # is the long pathname that we need to use from our current context to be # able to access the element. - #$element->setExtendedName ($_); + #$element->setExtendedName($_); push @changeset, $element; - } # foreach + } # for $self->{changeset} = \@changeset; return @changeset; } # changeset -sub create ($$$;$) { - my ($self, $stream, $pvob, $headline, $opts) = @_; +sub exists() { + my ($self) = @_; + + my ($status, @output) = $Clearcase::CC->execute( + 'lsactivity ' . $self->{name} . '@' . $self->pvob->tag + ); + + return !$status; +} # exists + +sub create($$$;$) { + my ($self, $stream, $headline, $opts) = @_; =pod @@ -638,7 +643,7 @@ Parameters: =over -=item UCM Stream (required) +=item UCM Stream(required) UCM stream this activities is to be created on @@ -674,34 +679,31 @@ Ouput from cleartool =cut - # Fill in members - $self->{stream} = $stream; - $self->{pvob} = $pvob; - - # TODO: Should quote $headline to protect from special characters - $self->{headline} = $headline; - + if ($self->exists) { + $self->updateActivityInfo; + + return (0, ()); + } # if + # Fill in opts $opts ||= ''; - $opts .= " -headline '$headline'" - if $headline; + + if ($headline) { + $self->{headline} = $headline; + + $opts .= " -headline '$headline'"; + } # if - # TODO: This should call the exists function - # Return the stream name if the stream already exists - my ($status, @output) = - $Clearcase::CC->execute ('lsact -short ' . $self->{name}); + $self->{stream} = Clearcase::UCM::Stream->new($stream, $self->{pvob}); - return ($status, @output) - unless $status; - - # Need to create the stream return $Clearcase::CC->execute - ("mkactivity $opts -in " . $stream . - "\@" . $pvob . - ' ' . $self->{name}); + ("mkactivity $opts -in " . $stream->{name} . + '@' . $self->pvob->{tag} . + ' ' . $self->{name} . + '@' . $self->pvob->{tag}); } # create -sub remove () { +sub remove() { my ($self) = @_; =pod @@ -743,10 +745,10 @@ Ouput from cleartool =cut return $Clearcase::CC->execute - ('rmactivity -f ' . $self->{name} . "\@" . $self->{pvob}); + ('rmactivity -f ' . $self->{name} . "\@" . $self->{pvob}->name); } # remove -sub attributes (;%) { +sub attributes(;%) { my ($self, %newAttribs) = @_; =pod @@ -783,14 +785,14 @@ Hash of attributes for this activity =cut - return $self->Clearcase::attributes ( + return $self->Clearcase::attributes( 'activity', - "$self->{name}\@" . Clearcase::vobtag ($self->{pvob}), + "$self->{name}\@" . $self->{pvob}->name, %newAttribs, ); } # attributes -sub updateActivityInfo () { +sub updateActivityInfo() { my ($self) = @_; # Get all information that can be gotten using -fmt @@ -806,8 +808,8 @@ sub updateActivityInfo () { $fmt = '%[contrib_acts]CXp=='; } # if - $Clearcase::CC->execute ( - "lsactivity -fmt \"$fmt\" $self->{name}@" . Clearcase::vobtag ($self->{pvob}) + $Clearcase::CC->execute( + "lsactivity -fmt \"$fmt\" $self->{name}@" . $self->{pvob}->name ); # Assuming this activity is an empty shell of an object that the user may @@ -829,9 +831,9 @@ sub updateActivityInfo () { $self->{contrib_acts} = (); if ($self->type eq 'integration') { - foreach (split ', ', $fields[7]) { - push @{$self->{contrib_acts}}, Clearcase::UCM::Activity->new ($_); - } # foreach + for (split ', ', $fields[7]) { + push @{$self->{contrib_acts}}, Clearcase::UCM::Activity->new($_); + } # for } # if return; diff --git a/lib/Clearcase/UCM/Baseline.pm b/lib/Clearcase/UCM/Baseline.pm index 48883e1..cf765a2 100644 --- a/lib/Clearcase/UCM/Baseline.pm +++ b/lib/Clearcase/UCM/Baseline.pm @@ -49,30 +49,24 @@ use warnings; use Carp; -use lib '../..'; - -use Clearcase; -use Clearcase::Element; -use Clearcase::UCM::Activity; - -sub _processOpts (%) { +sub _processOpts(%) { my ($self, %opts) = @_; my $opts; - foreach (keys %opts) { + for (keys %opts) { if ($_ eq 'cq' or $_ eq 'cqe' or $_ eq 'force' or $_ eq 'nc') { $opts .= "-$_ "; } elsif ($_ eq 'c' or $_ eq 'cfile') { $opts .= "-$_ $opts{$_}"; } # if - } # foreach + } # for return $opts; } # _processOpts -sub new ($$) { +sub new($$) { my ($class, $baseline, $pvob) = @_; =pod @@ -109,15 +103,15 @@ Returns: =cut - my $self = bless { + $class = bless { name => $baseline, - pvob => Clearcase::vobtag $pvob, + pvob => $pvob, }, $class; # bless - return $self; + return $class; } # new -sub name () { +sub name() { my ($self) = @_; =pod @@ -155,7 +149,7 @@ Returns: return $self->{name}; } # name -sub pvob () { +sub pvob() { my ($self) = @_; =pod @@ -193,14 +187,14 @@ Returns: return $self->{pvob}; } # pvob -sub create ($$;$$) { - my ($self, $project, $pvob, $baseline, $opts) = @_; +sub create($;$$$) { + my ($self, $view, $comment, $opts) = @_; =pod =head2 create -Creates a new UCM Stream Object +Creates a new UCM Baseline Object Parameters: @@ -208,21 +202,9 @@ Parameters: =over -=item UCM Project (required) - -UCM Project this stream belongs to - -=item PVOB (Required) - -Project Vob - -=item baseline - -Baseline to set this stream to - =item opts -Options: Additional options to use (e.g. -readonly) +Options: Additional options to use =back @@ -247,35 +229,18 @@ Ouput from cleartool =for html =cut - - # Fill in object members - $self->{project} = $project; - $self->{pvob} = $pvob; - # Fill in opts $opts ||= ''; - $opts .= " -baseline $baseline" - if $baseline; - $self->{readonly} = $opts =~ /-readonly/; - - # TODO: This should call the exists function - # Return the stream name if the stream already exists - my ($status, @output) = - $Clearcase::CC->execute ('lsstream -short ' . $self->{name}); + $comment = Clearcase::_setComment $comment; - return ($status, @output) - unless $status; - - # Need to create the stream - return $Clearcase::CC->execute - ("mkstream $opts -in " . $self->{project} . - "\@" . $self->{pvob} . - ' ' . $self->{name}); + return $Clearcase::CC->execute( + "mkbl $comment $opts -view " . $view->tag . ' ' . $self->{name} + ); } # create -sub remove (\%) { - my ($self, %opts) = @_; +sub remove($) { + my ($self, $opts) = @_; =pod @@ -315,14 +280,11 @@ Remember to check status method for error, and/or output method for output. =cut - my $opts = $self->_processOpts (%opts); - - my $pvob = Clearcase::vobtag ($self->{pvob}); - - my ($status, @output) = $Clearcase::CC->execute - ("rmbl $opts " . $self->{name} . '@' . $pvob); + $opts ||= ''; - return; + return $Clearcase::CC->execute( + "rmbl $opts -force " . $self->{name} . '@' . $self->{pvob}->name + ): } # remove sub attributes () { @@ -362,13 +324,13 @@ Hash of attributes for this baseline =cut - return $self->Clearcase::attributes ( + return $self->Clearcase::attributes( 'baseline', - "$self->{name}\@" . Clearcase::vobtag ($self->{pvob}) + "$self->{name}\@" . $self->{pvob}->name ); } # attributes -sub diff ($;$$) { +sub diff($;$$) { my ($self, $type, $baseline, %opts) = @_; =pod @@ -448,7 +410,7 @@ value. $cmd .= " -predeccsor"; } # if - $Clearcase::CC->execute ($cmd); + $Clearcase::CC->execute($cmd); return if $Clearcase::CC->status; @@ -456,13 +418,13 @@ value. my %info; - foreach (@output) { + for (@output) { next unless /^(\>\>|\<\<)/; if (/(\>\>|\<\<)\s+(\S+)\@/) { - $info{$2} = Clearcase::UCM::Activity->new ($2, $self->{pvob}); + $info{$2} = Clearcase::UCM::Activity->new($2, $self->{pvob}); } # if - } # foreach + } # for return %info; } # diff diff --git a/lib/Clearcase/UCM/Component.pm b/lib/Clearcase/UCM/Component.pm new file mode 100644 index 0000000..640cecb --- /dev/null +++ b/lib/Clearcase/UCM/Component.pm @@ -0,0 +1,353 @@ +=pod + +=head1 NAME $RCSfile: Component.pm,v $ + +Object oriented interface to UCM Component + +=head1 VERSION + +=over + +=item Author + +Andrew DeFaria + +=item Revision + +$Revision: 1.8 $ + +=item Created + +Fri May 14 18:16:16 PDT 2010 + +=item Modified + +$Date: 2011/11/15 02:00:58 $ + +=back + +=head1 SYNOPSIS + +Provides access to information about Clearcase Components. + + my $stream = new Clearcase::UCM::Component($name, $pvob); + +=head1 DESCRIPTION + +This module implements a UCM Component object + +=head1 ROUTINES + +The following routines are exported: + +=cut + +package Clearcase::UCM::Component; + +use strict; +use warnings; + +use Carp; + +sub new ($$) { + my ($class, $name, $pvob) = @_; + +=pod + +=head2 new + +Construct a new Clearcase Component object. + +Parameters: + +=for html
+ +=over + +=item name + +Name of Component + +=item pvob + +Associated pvob + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item Clearcase Component object + +=back + +=for html
+ +=cut + + $class = bless { + name => $name, + pvob => $pvob, + }, $class; # bless + + return $class; +} # new + +sub name () { + my ($self) = @_; + +=pod + +=head2 name + +Returns the name of the component + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item name + +=back + +=for html
+ +=cut + + return $self->{name}; +} # name + +sub pvob () { + my ($self) = @_; + +=pod + +=head2 pvob + +Returns the pvob of the component + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item pvob + +=back + +=for html
+ +=cut + + return $self->{pvob}; +} # pvob + +sub create (;$$) { + my ($self, $root, $comment) = @_; + +=pod + +=head2 create + +Creates a new UCM Component Object + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item $status + +Status from cleartool + +=item @output + +Ouput from cleartool + +=back + +=for html
+ +=cut + + return (0, ()) if $self->exists; + + $comment = Clearcase::_setComment $comment; + + my $rootOpt; + + if ($root) { + if (-d $root) { + $self->{root} = $root; + + $rootOpt = "-root $root"; + } else { + carp "Root $root not found"; + } # if + } else { + $self->{root} = undef; + + $rootOpt = '-nroot'; + } # if + + return $Clearcase::CC->execute( + "mkcomp $comment $rootOpt " . $self->{name} . '@' . $self->{pvob}->tag + ); +} # create + +sub remove () { + my ($self) = @_; + +=pod + +=head2 remove + +Removes UCM Component + +Parameters: + +=for html
+ +=over + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item $status + +Status from cleartool + +=item @output + +Ouput from cleartool + +=back + +=for html
+ +=cut + + return $Clearcase::CC->execute + ('rmcomp -f ' . $self->{name} . '@' . $self->{pvob}->name); +} # remove + +sub exists() { + my ($self) = @_; + +=pod + +=head3 exists + +Returns true if the component exists - false otherwise. + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item boolean + +=back + +=for html
+ +=cut + + my ($status, @output) = $Clearcase::CC->execute( + 'lscomp ' . $self->{name} . '@' . $self->{pvob}->name + ); + + return !$status; +} # exists + +1; + +=head1 DEPENDENCIES + +=head2 ClearSCM Perl Modules + +=for html

Clearcase

+ +=for html

Clearcase::UCM::Baseline

+=for html

Clearcase::UCM::Project

+ +=head1 INCOMPATABILITIES + +None + +=head1 BUGS AND LIMITATIONS + +There are no known bugs in this module. + +Please report problems to Andrew DeFaria . + +=head1 LICENSE AND COPYRIGHT + +Copyright (c) 2007, ClearSCM, Inc. All rights reserved. + +=cut diff --git a/lib/Clearcase/UCM/Folder.pm b/lib/Clearcase/UCM/Folder.pm new file mode 100644 index 0000000..26661a5 --- /dev/null +++ b/lib/Clearcase/UCM/Folder.pm @@ -0,0 +1,443 @@ +=pod + +=head1 NAME $RCSfile: Folder.pm,v $ + +Object oriented interface to UCM Folders + +=head1 VERSION + +=over + +=item Author + +Andrew DeFaria + +=item Revision + +$Revision: 1.8 $ + +=item Created + +Fri May 14 18:16:16 PDT 2010 + +=item Modified + +$Date: 2011/11/15 02:00:58 $ + +=back + +=head1 SYNOPSIS + +Provides access to information about Clearcase Folders. + + my $folder = new Clearcase::UCM::Folder ($name, $pvob); + +=head1 DESCRIPTION + +This module implements a UCM Folder object + +=head1 ROUTINES + +The following routines are exported: + +=cut + +package Clearcase::UCM::Folder; + +use strict; +use warnings; + +sub new ($$;$$) { + my ($class, $name, $pvob, $parent, $comment) = @_; + +=pod + +=head2 new + +Construct a new Clearcase Folder object. + +Parameters: + +=for html
+ +=over + +=item folder + +Name of folder + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item Clearcase Folder object + +=back + +=for html
+ +=cut + + $class = bless { + name => $name, + pvob => $pvob, + parent => $parent || 'RootFolder', + }, $class; # bless + + $comment = Clearcase::_setComment ($comment); + + my ($status, @output) = $Clearcase::CC->execute ( + "mkfolder $comment -in " . $class->{parent} . ' ' . $name . '@' . $pvob->tag + ); + + return $class->updateFolderInfo; +} # new + +sub name () { + my ($self) = @_; + +=pod + +=head2 name + +Returns the name of the folder + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item folder's name + +=back + +=for html
+ +=cut + + return $self->{name}; +} # name + +sub owner () { + my ($self) = @_; + +=pod + +=head2 owner + +Returns the owner of the folder + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item folder's owner + +=back + +=for html
+ +=cut + + return $self->{owner}; +} # owner + +sub group () { + my ($self) = @_; + +=pod + +=head2 group + +Returns the group of the folder + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item folder's group + +=back + +=for html
+ +=cut + + return $self->{group}; +} # group + +sub pvob () { + my ($self) = @_; + +=pod + +=head2 pvob + +Returns the pvob of the folder + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item folder's pvob + +=back + +=for html
+ +=cut + + return $self->{pvob}; +} # pvob + +sub title () { + my ($self) = @_; + +=pod + +=head2 title + +Returns the title of the folder + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item folder's title + +=back + +=for html
+ +=cut + + return $self->{title}; +} # title + +sub create ($;$) { + my ($self, $name, $parentFolder) = @_; + +=pod + +=head2 create + +Creates a new UCM Folder Object + +Parameters: + +=for html
+ +=over + +=item name + +UCM Folder name + +=item parentFolder + +Name of parentFolder (Default: RootFolder) + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item $status + +Status from cleartool + +=item @output + +Ouput from cleartool + +=back + +=for html
+ +=cut + + # Fill in object members + $self->{parentFolder} = $parentFolder; + + $parentFolder ||= 'RootFolder'; + + # Need to create the folder + return $Clearcase::CC->execute( + "mkfolder $self->{comment} -in " . $parentFolder . '@' . $self->{pvob} . + ' ' . $self->{name} + ); +} # create + +sub remove () { + my ($self) = @_; + +=pod + +=head2 remove + +Removes UCM Folder + +Parameters: + +=for html
+ +=over + +=item name + +UCM Folder name + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item $status + +Status from cleartool + +=item @output + +Output from cleartool + +=back + +=for html
+ +=cut + + return $Clearcase::CC->execute( + 'rmfolder -f ' . $self->{name} . "\@" . $self->{pvob}); +} # rmfolder + +sub updateFolderInfo () { + my ($self) = @_; + + my ($status, @output) = $Clearcase::CC->execute( + "lsfolder -long $self->{name}" . '@'. $self->{pvob}->tag); + + return if $status; + + for (@output) { + if (/owner: (.*)/) { + $self->{owner} = $1; + } elsif (/group: (.*)/) { + $self->{group} = $1; + } elsif (/title: (.*)/) { + $self->{title} = $1; + # TODO: Get containing folders and containing projects + } # if + } # for + + return $self; +} # updateFolderInfo +1; + +=head1 DEPENDENCIES + +=head2 ClearSCM Perl Modules + +=for html

Clearcase

+ +=for html

Clearcase::UCM::Baseline

+ +=head1 INCOMPATABILITIES + +None + +=head1 BUGS AND LIMITATIONS + +There are no known bugs in this module. + +Please report problems to Andrew DeFaria . + +=head1 LICENSE AND COPYRIGHT + +Copyright (c) 2007, ClearSCM, Inc. All rights reserved. + +=cut diff --git a/lib/Clearcase/UCM/Project.pm b/lib/Clearcase/UCM/Project.pm new file mode 100644 index 0000000..8db0f86 --- /dev/null +++ b/lib/Clearcase/UCM/Project.pm @@ -0,0 +1,342 @@ +=pod + +=head1 NAME $RCSfile: Project.pm,v $ + +Object oriented interface to UCM Projects + +=head1 VERSION + +=over + +=item Author + +Andrew DeFaria + +=item Revision + +$Revision: 1.8 $ + +=item Created + +Fri May 14 18:16:16 PDT 2010 + +=item Modified + +$Date: 2011/11/15 02:00:58 $ + +=back + +=head1 SYNOPSIS + +Provides access to information about Clearcase UCM Projects. + + my $project = new Clearcase::UCM::Project ($name, $folder, $pvob); + +=head1 DESCRIPTION + +This module implements a UCM Project object + +=head1 ROUTINES + +The following routines are exported: + +=cut + +package Clearcase::UCM::Project; + +use strict; +use warnings; + +sub new ($$) { + my ($class, $name, $folder, $pvob) = @_; + +=pod + +=head2 new + +Construct a new Clearcase Project object. + +Parameters: + +=for html
+ +=over + +=item project + +Name of project + +=item folder + +Folder object + +=item pvob + +Associated Pvob + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item Clearcase Project object + +=back + +=for html
+ +=cut + + $folder = Clearcase::UCM::Folder->new('RootFolder', $pvob) unless $folder; + + $class = bless { + name => $name, + folder => $folder, + pvob => $pvob, + }, $class; # bless + + return $class; +} # new + +sub name () { + my ($self) = @_; + +=pod + +=head2 name + +Returns the name of the project + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item project's name + +=back + +=for html
+ +=cut + + return $self->{name}; +} # name + +sub pvob () { + my ($self) = @_; + +=pod + +=head2 pvob + +Returns the pvob of the project + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item project's pvob + +=back + +=for html
+ +=cut + + return $self->{pvob}; +} # pvob + +sub create (;$) { + my ($self, $opts) = @_; + +=pod + +=head2 create + +Creates a new UCM Project Object + +Parameters: + +=for html
+ +=over + +=item opts + +Optional parameters for cleartool mkproject command + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item $status + +Status from cleartool + +=item @output + +Ouput from cleartool + +=back + +=for html
+ +=cut + + return (0, ()) if $self->exists; + + $opts ||= ''; + + return $Clearcase::CC->execute( + "mkproject $opts -in " . $self->{folder}->name . '@' . $self->{pvob}->tag . + ' ' . $self->{name} . '@' . $self->{pvob}->tag + ); +} # create + +sub remove () { + my ($self) = @_; + +=pod + +=head2 remove + +Removes UCM Project + +Parameters: + +=for html
+ +=over + +=for html
+ +Returns: + +=for html
+ +=over + +=item $status + +Status from cleartool + +=item @output + +Ouput from cleartool + +=back + +=for html
+ +=cut + + return $Clearcase::CC->execute + ('rmproject -f ' . $self->{name} . "\@" . $self->{pvob}->name); +} # rmProject + +sub exists() { + my ($self) = @_; + +=pod + +=head3 exists + +Returns true if the project exists - false otherwise + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item boolean + +=back + +=for html
+ +=cut + + my ($status, @output) = $Clearcase::CC->execute( + 'lsproject ' . $self->{name} . '@' . $self->{pvob}->name + ); + + return !$status; +} # exists + +1; + +=head1 DEPENDENCIES + +=head2 ClearSCM Perl Modules + +=for html

Clearcase

+ +=for html

Clearcase::UCM::Folder

+ +=head1 INCOMPATABILITIES + +None + +=head1 BUGS AND LIMITATIONS + +There are no known bugs in this module. + +Please report problems to Andrew DeFaria . + +=head1 LICENSE AND COPYRIGHT + +Copyright (c) 2007, ClearSCM, Inc. All rights reserved. + +=cut diff --git a/lib/Clearcase/UCM/Pvob.pm b/lib/Clearcase/UCM/Pvob.pm index 00fe5e1..0b39949 100644 --- a/lib/Clearcase/UCM/Pvob.pm +++ b/lib/Clearcase/UCM/Pvob.pm @@ -47,11 +47,14 @@ package Clearcase::UCM::Pvob; use strict; use warnings; -use Clearcase; -use Clearcase::UCM::Stream; +# Would be better represented by use parent "Clearcase::Vob" but we're +# working with old versions of Perl here... +use base 'Clearcase::Vob'; + +use Carp; sub new ($) { - my ($class, $name) = @_; + my ($class, $tag) = @_; =pod @@ -65,7 +68,7 @@ Parameters: =over -=item pvob name +=item name Name of pvob @@ -87,21 +90,65 @@ Returns: =cut - my $self = bless { - name => $name, + croak 'Clearcase::UCM::Pvob: Must specify pvob tag' unless $tag; + + $class = bless { + tag => $tag, }, $class; # bless - return $self; + $class->updateVobInfo; + + return $class; } # new -sub name () { +sub create (;$$$%) { + my ($self, $host, $vbs, $comment, %opts) = @_; + +=pod + +=head2 create + +Creates a pvob + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +=cut + + $opts{ucmproject} = undef; + + return $self->SUPER::create ($host, $vbs, $comment, %opts); +} # create + +sub tag() { my ($self) = @_; =pod -=head2 name +=head2 tag -Returns the name of the pvob +Returns the tag of the pvob Parameters: @@ -121,7 +168,7 @@ Returns: =over -=item pvob's name +=item tag =back @@ -129,7 +176,12 @@ Returns: =cut - return $self->{name}; + return $self->{tag}; +} # tag + +# Alias name to tag +sub name() { + goto &tag; } # name sub streams () { @@ -176,7 +228,7 @@ Returns: my @streams; push @streams, Clearcase::UCM::Stream->new ($_, $self->{name}) - foreach ($Clearcase::CC->output); + for ($Clearcase::CC->output); return @streams; } # streams diff --git a/lib/Clearcase/UCM/Stream.pm b/lib/Clearcase/UCM/Stream.pm index 0cdc198..496bee3 100644 --- a/lib/Clearcase/UCM/Stream.pm +++ b/lib/Clearcase/UCM/Stream.pm @@ -28,9 +28,9 @@ $Date: 2011/11/15 02:00:58 $ =head1 SYNOPSIS -Provides access to information about Clearcase Elements. +Provides access to information about Clearcase Streams. - my $stream= new Clearcase::UCM::Stream ($name, $pvob); + my $stream = new Clearcase::UCM::Stream ($name, $pvob); =head1 DESCRIPTION @@ -47,11 +47,8 @@ package Clearcase::UCM::Stream; use strict; use warnings; -use Clearcase; -use Clearcase::UCM::Baseline; - sub new ($$) { - my ($class, $stream, $pvob) = @_; + my ($class, $name, $pvob) = @_; =pod @@ -65,10 +62,14 @@ Parameters: =over -=item stream name +=item name Name of stream +=item pvob + +Associated pvob + =back =for html @@ -87,12 +88,12 @@ Returns: =cut - my $self = bless { - name => $stream, - pvob => Clearcase::vobtag $pvob, + $class = bless { + name => $name, + pvob => $pvob, }, $class; # bless - return $self; + return $class; } # new sub name () { @@ -171,8 +172,8 @@ Returns: return $self->{pvob}; } # pvob -sub create ($$;$$) { - my ($self, $project, $pvob, $baseline, $opts) = @_; +sub create ($;$) { + my ($self, $project, $opts) = @_; =pod @@ -186,21 +187,13 @@ Parameters: =over -=item UCM Project (required) - -UCM Project this stream belongs to - -=item PVOB (Required) - -Project Vob - -=item baseline +=item project -Baseline to set this stream to +Project that this stream will be created in =item opts -Options: Additional options to use (e.g. -readonly) +Options: Additional options to use (e.g. -baseline/-readonly) =back @@ -226,30 +219,17 @@ Ouput from cleartool =cut - # Fill in object members - $self->{project} = $project; - $self->{pvob} = $pvob; - - # Fill in opts + return (0, ()) if $self->exists; + $opts ||= ''; - $opts .= " -baseline $baseline" - if $baseline; - + $self->{readonly} = $opts =~ /-readonly/; - - # TODO: This should call the exists function - # Return the stream name if the stream already exists - my ($status, @output) = - $Clearcase::CC->execute ('lsstream -short ' . $self->{name}); - return ($status, @output) - unless $status; - - # Need to create the stream - return $Clearcase::CC->execute - ("mkstream $opts -in " . $self->{project} . - "\@" . $self->{pvob} . - ' ' . $self->{name}); + return $Clearcase::CC->execute( + "mkstream $opts -in " + . $project->name . '@' . $self->{pvob}->tag . ' ' + . $self->name . '@' . $self->{pvob}->tag + ); } # create sub remove () { @@ -267,21 +247,56 @@ Parameters: =over -=item UCM Project (required) +=back + +=for html + +Returns: + +=for html
+ +=over + +=item $status + +Status from cleartool + +=item @output + +Ouput from cleartool + +=back + +=for html
+ +=cut + + return $Clearcase::CC->execute + ('rmstream -f ' . $self->{name} . '@' . $self->{pvob}->name); +} # rmStream + +sub rebase($;$) { + my ($self, $baseline, $opts) = @_; + +=pod + +=head2 rebase -UCM Project this stream belongs to +Rebases a UCM Stream -=item PVOB (Required) +Parameters: -Project Vob +=for html
+ +=over =item baseline -Baseline to set this stream to +Baseline to rebase to =item opts -Options: Additional options to use (e.g. -readonly) +Any additional opts =back @@ -307,9 +322,61 @@ Ouput from cleartool =cut - return $Clearcase::CC->execute - ('rmstream -f ' . $self->{name} . "\@" . $self->{pvob}); -} # rmStream + $opts ||= ''; + + $opts .= ' -baseline ' . $baseline . + ' -stream ' . $self->name . '@' . $self->{pvob}->name; + + return $Clearcase::CC->execute("rebase $opts"); +} # rebase + +sub recommend($) { + my ($self, $baseline) = @_; + +=pod + +=head2 recommend + +Recommends a baseline in a UCM Stream + +Parameters: + +=for html
+ +=over + +=item baseline + +Baseline to recommend + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item $status + +Status from cleartool + +=item @output + +Ouput from cleartool + +=back + +=for html
+ +=cut + + return $Clearcase::CC->execute( + "chstream -recommended $baseline " . $self->name . '@' . $self->{pvob}->tag + ); +} # recommend sub baselines () { my ($self) = @_; @@ -356,15 +423,57 @@ An array of baseline objects for this stream my @baselines; - foreach ($Clearcase::CC->output) { + for ($Clearcase::CC->output) { my $baseline = Clearcase::UCM::Baseline->new ($_, $self->{pvob}); push @baselines, $baseline; - } # foreach + } # for return @baselines; } # baselines +sub exists() { + my ($self) = @_; + +=pod + +=head3 exists + +Return true if the stream exists - false otherwise + +Paramters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item boolean + +=back + +=for html
+ +=cut + + my ($status, @output) = $Clearcase::CC->execute( + 'lsstream ' . $self->{name} . '@' . $self->{pvob}->name + ); + + return !$status; +} # exists + 1; =head1 DEPENDENCIES @@ -374,6 +483,7 @@ An array of baseline objects for this stream =for html

Clearcase

=for html

Clearcase::UCM::Baseline

+=for html

Clearcase::UCM::Project

=head1 INCOMPATABILITIES diff --git a/lib/Clearcase/UCM/Streams.pm b/lib/Clearcase/UCM/Streams.pm new file mode 100644 index 0000000..6d0c99d --- /dev/null +++ b/lib/Clearcase/UCM/Streams.pm @@ -0,0 +1,165 @@ +=pod + +=head1 NAME $RCSfile: Stream.pm,v $ + +Object oriented interface to UCM Streams + +=head1 VERSION + +=over + +=item Author + +Andrew DeFaria + +=item Revision + +$Revision: 1.8 $ + +=item Created + +Fri May 14 18:16:16 PDT 2010 + +=item Modified + +$Date: 2011/11/15 02:00:58 $ + +=back + +=head1 SYNOPSIS + +Provides access to information about Clearcase Streams. + + my $stream = new Clearcase::UCM::Streams() + +=head1 DESCRIPTION + +This module implements a UCM Streams object + +=head1 ROUTINES + +The following routines are exported: + +=cut + +package Clearcase::UCM::Streams; + +use strict; +use warnings; + +sub new ($) { + my ($class, $pvob) = @_; + +=pod + +=head2 new + +Construct a new Clearcase Streams object + +Parameters: + +=for html
+ +=over + +=item pvob + +Pvob object + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item Clearcase Streams object + +=back + +=for html
+ +=cut + + my ($status, @output) = + $clearcase::CC->execute('lsstream -short -invob ' . $pvob->tag; + + my $class = bless { + streams => @output, + }, $class; # bless + + return $class; +} # new + +sub streams () { + my ($self) = @_; + +=pod + +=head2 streams + +Return a list of stream names in an array context or the number of streams in +a scalar context. + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item List of streams or number of streams + +Array of stream names in an array context or the number of streams in a scalar +context. + +=back + +=for html
+ +=cut + + if (wantarray) { + return $self->{streams} ? sort @{$self->{streams}) : (); + } else { + return $self->{streams} ? scalar @{$self->{streams}); + } # if +} # streams + +1; + +=head1 DEPENDENCIES + +=head2 ClearSCM Perl Modules + +=for html

Clearcase

+ +=head1 INCOMPATABILITIES + +None + +=head1 BUGS AND LIMITATIONS + +There are no known bugs in this module. + +Please report problems to Andrew DeFaria . + +=head1 LICENSE AND COPYRIGHT + +Copyright (c) 2007, ClearSCM, Inc. All rights reserved. + +=cut diff --git a/lib/Clearcase/UCM/testinfo.txt b/lib/Clearcase/UCM/testinfo.txt new file mode 100644 index 0000000..0797c6c --- /dev/null +++ b/lib/Clearcase/UCM/testinfo.txt @@ -0,0 +1,2 @@ +WOR: RANCQ00090968 +UCM Project: test6@/vobs/killme_pvob diff --git a/lib/Clearcase/View.pm b/lib/Clearcase/View.pm index 7a59cd2..77cfc6a 100644 --- a/lib/Clearcase/View.pm +++ b/lib/Clearcase/View.pm @@ -127,8 +127,8 @@ use warnings; use Clearcase; use Display; -sub new ($;$) { - my ($class, $tag, $region) = @_; +sub new ($) { + my ($class, $tag) = @_; =pod @@ -172,7 +172,7 @@ Returns: my $self = bless { tag => $tag }, $class; - $self->updateViewInfo ($region); + $self->updateViewInfo; return $self; } # new @@ -1170,6 +1170,11 @@ Returns: return $self->{tag}; } # tag +# Alias name to tag +sub name() { + goto &tag; +} # name + sub text_mode () { my ($self) = @_; @@ -1363,7 +1368,7 @@ Returns: } # exists sub create (;$$$) { - my ($self, $host, $vws, $region) = @_; + my ($self, $host, $vws, $opts) = @_; =pod @@ -1409,34 +1414,37 @@ Ouput from cleartool =cut - $region ||= $Clearcase::CC->region; - if ($self->exists) { - $self->updateViewInfo ($region); + $self->updateViewInfo; return (0, ()) } # if my ($status, @output); + $opts ||= ''; + if ($host && $vws) { - ($status, @output) = - $Clearcase::CC->execute ("mkview -tag $self->{tag} -region $region " - . "-host $host -hpath $vws -gpath $vws $vws"); + ($status, @output) = $Clearcase::CC->execute( + "mkview -tag $self->{tag} $opts " . + "-host $host -hpath $vws -gpath $vws $vws" + ); } else { # Note this requires that -stgloc's work and that using -auto is not a # problem. - ($status, @output) = - $Clearcase::CC->execute ("mkview -tag $self->{tag} -stgloc -auto"); + ($status, @output) = $Clearcase::CC->execute( + "mkview -tag $self->{tag} $opts -stgloc -auto" + ); } # if - $self->updateViewInfo ($region); + $self->updateViewInfo; return ($status, @output); } # create +# TODO Is this used? sub createUCM ($$) { - my ($self, $stream, $pvob, $region) = @_; + my ($self, $stream, $pvob) = @_; =pod @@ -1482,14 +1490,10 @@ Array of output =cut - $region ||= $Clearcase::CC->region; - - return (0, ()) - if $self->exists; + return (0, ()) if $self->exists; # Update object members - $self->{stream} = $stream; - $self->{pvob} = $pvob; + $self->{pvob} = $pvob; # Need to create the view my ($status, @output) = @@ -1499,7 +1503,7 @@ Array of output return ($status, @output) if $status; - $self->updateViewInfo ($region); + $self->updateViewInfo; return ($status, @output); } # createUCM @@ -1545,12 +1549,13 @@ Ouput from cleartool =cut - return (0, ()) - unless $self->exists; + return (0, ()) unless $self->exists; my ($status, @output); if ($self->dynamic) { + $self->stop; + ($status, @output) = $Clearcase::CC->execute ( "rmview -force -tag $self->{tag}" ); @@ -1744,13 +1749,11 @@ Ouput from cleartool return ($status, @output); } # set -sub updateViewInfo ($$) { - my ($self, $region) = @_; - - $region ||= $Clearcase::CC->region; +sub updateViewInfo () { + my ($self) = @_; my ($status, @output) = $Clearcase::CC->execute ( - "lsview -region $region -long -properties -full $self->{tag}" + "lsview -long -properties -full $self->{tag}" ); # Assuming this view is an empty shell of an object that the user may possibly diff --git a/lib/Clearcase/Vob.pm b/lib/Clearcase/Vob.pm index 6c957c0..142c1dc 100644 --- a/lib/Clearcase/Vob.pm +++ b/lib/Clearcase/Vob.pm @@ -264,6 +264,10 @@ Returns: return $self->{shost}; } # shost +# Alias name to tag +sub name() { + goto &tag; +} # name sub access () { my ($self) = @_; @@ -1177,8 +1181,8 @@ Returns: return !$status; } # exists -sub create (;$$$) { - my ($self, $host, $vbs, $comment) = @_; +sub create (;$$$%) { + my ($self, $host, $vbs, $comment, %opts) = @_; =pod @@ -1232,20 +1236,26 @@ Ouput from cleartool return (0, ()) if $self->exists; - $comment = Clearcase::setComment $comment; + $comment = Clearcase::_setComment $comment; my ($status, @output); + my $additionalOpts = ''; + + for (keys %opts) { + $additionalOpts .= "-$_ "; + $additionalOpts .= "$opts{$_} " if $opts{$_}; + } # for + if ($host && $vbs) { ($status, @output) = $Clearcase::CC->execute ( - "mkvob -tag $self->{tag} $comment -host $host -hpath $vbs " + "mkvob -tag $self->{tag} $comment $additionalOpts -host $host -hpath $vbs " . "-gpath $vbs $vbs"); } else { # Note this requires that -stgloc's work and that using -auto is not a # problem. ($status, @output) = - $Clearcase::CC->execute ("mkvob -tag $self->{tag} $comment " - . "-stgloc -auto"); + $Clearcase::CC->execute ("mkvob -tag $self->{tag} $comment $additionalOpts -stgloc -auto"); } # if $self->updateVobInfo; diff --git a/lib/Clearcase/Vobs.pm b/lib/Clearcase/Vobs.pm index 9630a7f..0f2d85f 100644 --- a/lib/Clearcase/Vobs.pm +++ b/lib/Clearcase/Vobs.pm @@ -113,7 +113,7 @@ Returns: # Strip $VOBTAG_PREFIX foreach (@output) { - if ($ARCH eq 'windows' or $ARCH eq 'cygwin') { + if ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin') { s/\\//; } else { s/$Clearcase::VOBTAG_PREFIX//; diff --git a/lib/Clearquest.pm b/lib/Clearquest.pm index 1abb5da..a31cb88 100644 --- a/lib/Clearquest.pm +++ b/lib/Clearquest.pm @@ -232,7 +232,7 @@ my $operatorRE = qr/ END { # Insure all instaniated objects have been destroyed - $_->DESTROY foreach (@objects); + $_->DESTROY for (@objects); } # END # Internal methods @@ -568,18 +568,18 @@ sub _setFields ($@) { } # if unless (@fields) { - # Always return dbid - push @fields, 'dbid' unless grep {$_ eq 'dbid'} @fields; - - foreach (@{$entityDef->GetFieldDefNames}) { + for (@{$entityDef->GetFieldDefNames}) { unless ($self->{returnSystemFields}) { next if $entityDef->IsSystemOwnedFieldDefName ($_); } # unless push @fields, $_; - } # foreach + } # for } # unless + # Always return dbid + push @fields, 'dbid' unless grep {$_ eq 'dbid'} @fields; + return @fields; } # _setFields @@ -616,11 +616,11 @@ sub _setFieldValue ($$$$) { # evaluate $fieldValue if $fieldValue is a simple number (e.g. 0, 1, etc.) $errmsg = $entity->SetFieldValue ($fieldName, "$fieldValue") if $fieldValue; } else { - foreach (@$fieldValue) { + for (@$fieldValue) { $errmsg = $entity->AddFieldValue ($fieldName, $_); return $errmsg unless $errmsg eq ''; - } # foreach + } # for } # unless return $errmsg; @@ -743,7 +743,7 @@ The DBID of the newly added record or undef if error. } # if # First process all fields in @ordering, if specified - foreach (@ordering) { + for (@ordering) { if ($values{$_}) { $self->{errmsg} = $self->_setFieldValue ($entity, $table, $_, $values{$_}); } else { @@ -751,18 +751,18 @@ The DBID of the newly added record or undef if error. } # if last unless $self->{errmsg} eq ''; - } # foreach + } # for return unless $self->{errmsg} eq ''; # Now process the rest of the values - foreach my $fieldName (keys %values) { + for my $fieldName (keys %values) { next if grep {$fieldName eq $_} @ordering; $self->{errmsg} = $self->_setFieldValue ($entity, $table, $fieldName, $values{$fieldName}); last unless $self->{errmsg} eq ''; - } # foreach + } # for $self->_setError ($self->{errmsg}); @@ -955,8 +955,8 @@ not the default DBSet as defined in cq.conf. return $connectionStr; } # connection -sub checkErr (;$$) { - my ($self, $msg, $die) = @_; +sub checkErr (;$$$) { + my ($self, $msg, $die, $log) = @_; =pod @@ -1009,9 +1009,14 @@ Returns 0 for no error, non-zero if error. } # if if ($die) { - croak $msg if $die; + $log->err ($msg) if $log; + croak $msg; } else { - print STDERR "$msg\n"; + if ($log) { + $log->err($msg); + } else { + print STDERR "$msg\n"; + } # if return $self->{error}; } # if @@ -1402,9 +1407,9 @@ Fieldtype enum my $entityDef = $self->{session}->GetEntityDef ($table); - foreach (@{$entityDef->GetFieldDefNames}) { + for (@{$entityDef->GetFieldDefNames}) { $FIELDS{$table}{$_} = $entityDef->GetFieldDefType ($_); - } # foreach + } # for if (defined $FIELDS{$table}{$fieldName}) { return $FIELDS{$table}{$fieldName} @@ -1610,7 +1615,7 @@ is also returned. my $query = $self->{session}->BuildQuery ($table); - foreach (@fields) { + for (@fields) { eval {$query->BuildField ($_)}; if ($@) { @@ -1618,7 +1623,7 @@ is also returned. carp $@; } # if - } # foreach + } # for $self->_parseConditional ($query, $condition); @@ -1762,7 +1767,7 @@ Hash of name/value pairs for all the fields in $table my %record; - foreach (@fields) { + for (@fields) { my $fieldType = $entity->GetFieldValue ($_)->GetType; if ($fieldType == $CQPerlExt::CQ_REFERENCE_LIST) { @@ -1776,7 +1781,7 @@ Hash of name/value pairs for all the fields in $table $record{$_} = _UTC2Localtime ($record{$_}); } # if } # if - } # foreach + } # for $self->_setError; @@ -1855,7 +1860,7 @@ Hash of name/value pairs for all the fields in $table my %record; - foreach (@fields) { + for (@fields) { my $fieldType = $entity->GetFieldValue ($_)->GetType; if ($fieldType == $CQPerlExt::CQ_REFERENCE_LIST) { @@ -1869,7 +1874,7 @@ Hash of name/value pairs for all the fields in $table $record{$_} = _UTC2Localtime ($record{$_}); } # if } # if - } # foreach + } # for $self->_setError; @@ -2004,15 +2009,16 @@ while () { # Format %record while ($column <= $nbrColumns) { - my $value = $result->{result}->GetColumnValue ($column); - - $value ||= '' if $self->{emptyStringForUndef}; + my $name = $result->{result}->GetColumnLabel($column); + my $value = $result->{result}->GetColumnValue($column++); # Fix any UTC dates - _UTC2Localtime will only modify data if the data # matches a UTC datetime. - $value = _UTC2Localtime ($value); + $value = _UTC2Localtime ($value) if $value; - $record{$result->{result}->GetColumnLabel ($column++)} = $value; + $value ||= '' if $self->{emptyStringForUndef}; + + $record{$name} = $value; } # while %{$result->{lastRecord}} = %record unless $result->{lastRecord}; @@ -2024,7 +2030,7 @@ while () { if ($result->{thisDBID} == $result->{lastDBID}) { # Since the dbid's are the same, we have at least one reference list field # and we need to compare all fields - foreach my $field (keys %record) { + for my $field (keys %record) { # If the field is blank then skip it next if $record{$field} eq ''; @@ -2049,7 +2055,7 @@ while () { push @{$result->{lastRecord}{$field}}, $record{$field} unless grep {/^$record{$field}$/} @{$result->{lastRecord}{$field}}; } # if - } # foreach + } # for # Transfer %lastRecord -> %record %record = %{$result->{lastRecord}}; @@ -2069,6 +2075,9 @@ while () { $self->_setError; + # Never return dbid... + delete $record{dbid}; + return %record; } # getNext @@ -2324,7 +2333,7 @@ The $errmsg, if any, when performing the update (empty string for success) } # if # First process all fields in @ordering, if specified - foreach (@ordering) { + for (@ordering) { if ($values{$_}) { $self->{errmsg} = $self->_setFieldValue ($table, $_, $values{$_}); } else { @@ -2332,18 +2341,18 @@ The $errmsg, if any, when performing the update (empty string for success) } # if last unless $self->{errmsg} eq ''; - } # foreach + } # for return $self->{errmsg} unless $self->{errmsg} eq ''; # Now process the rest of the values - foreach my $fieldName (keys %values) { + for my $fieldName (keys %values) { next if grep {$fieldName eq $_} @ordering; $self->{errmsg} = $self->_setFieldValue ($entity, $table, $fieldName, $values{$fieldName}); last unless $self->{errmsg} eq ''; - } # foreach + } # for $self->_setError ($self->{errmsg}); diff --git a/lib/OSDep.pm b/lib/OSDep.pm index 37fed79..507e523 100644 --- a/lib/OSDep.pm +++ b/lib/OSDep.pm @@ -32,14 +32,14 @@ This module seeks to isolate OS dependences by confining them to this module as well as provide convienent references and mechanisms for doing things that are different on different OSes. - print "Running on $ARCH\n"; + print "Running on $ARCHITECTURE\n"; `$cmd > $NULL 2>&1`; my $filename = $app_base . $SEPARATOR . "datafile.txt"; =head1 DESCRIPTION This module exports several variables that are useful to isolate OS -dependencies. For example, $ARCH is set to "windows", "cygwin" or the +dependencies. For example, $ARCHITECTURE is set to "windows", "cygwin" or the value of $^O depending on which OS the script is running. This allows you to write code that is dependant on which OS you are running on. Similarly, $NULL is set to the string "NUL" when running on @@ -64,19 +64,19 @@ use warnings; use base 'Exporter'; -our $ARCH = $^O =~ /MSWin/ - ? 'windows' - : $^O =~ /cygwin/ - ? "cygwin" - : $^O; -our $NULL = $^O =~ /MSWin/ ? 'NUL' : '/dev/null'; -our $SEPARATOR = $^O =~ /MSWin/ ? '\\' : '/'; -our $TRUE = 1; -our $FALSE = 0; -our $ROOT = $^O =~ /MSWin/ ? $ENV {SYSTEMDRIVE} . $SEPARATOR : "/"; +our $ARCHITECTURE = $^O =~ /MSWin/ + ? 'windows' + : $^O =~ /cygwin/ + ? "cygwin" + : $^O; +our $NULL = $^O =~ /MSWin/ ? 'NUL' : '/dev/null'; +our $SEPARATOR = $^O =~ /MSWin/ ? '\\' : '/'; +our $TRUE = 1; +our $FALSE = 0; +our $ROOT = $^O =~ /MSWin/ ? $ENV {SYSTEMDRIVE} . $SEPARATOR : "/"; our @EXPORT = qw ( - $ARCH + $ARCHITECTURE $FALSE $NULL $SEPARATOR @@ -135,7 +135,7 @@ Returns: =cut - if ($ARCH eq "windows" or $ARCH eq "cygwin") { + if ($ARCHITECTURE eq "windows" or $ARCHITECTURE eq "cygwin") { # Not sure how this relates to Windows/Cygwin environment so just # return false return $FALSE; @@ -152,7 +152,7 @@ Returns: =over -=item $ARCH +=item $ARCHITECTURE Set to either "windows", "cygwin" or $^O. diff --git a/lib/Utils.pm b/lib/Utils.pm index 78af171..f52fe4b 100644 --- a/lib/Utils.pm +++ b/lib/Utils.pm @@ -156,7 +156,7 @@ Returns: or error "Can't write to $errorlog ($!)", 1; # Change the current directory to / - my $ROOT = $ARCH eq "windows" ? "C:\\" : "/"; + my $ROOT = $ARCHITECTURE eq "windows" ? "C:\\" : "/"; chdir $ROOT or error "Can't chdir to $ROOT ($!), 1"; @@ -232,17 +232,11 @@ STDOUT then do so in the $command passed in. =cut - # Save $SIG{CHLD} so we can set it to 'DEFAULT' and then restore it later. - # Helps when you are doing process handling. - my $sigchld = $SIG{CHLD}; - local $SIG{CHLD} = 'DEFAULT'; my @output = `$cmd`; my $status = $?; - local $SIG{CHLD} = $sigchld; - chomp @output; return ($status, @output); @@ -363,7 +357,7 @@ Returns: while () { my $key; - while (not defined ($key = ReadKey -1)) { } + while (not defined ($key = ReadKey -1)) { } if ($key =~ /(\r|\n)/) { print "\n"; diff --git a/rc/bash_login b/rc/bash_login index c8807d0..39677cc 100644 --- a/rc/bash_login +++ b/rc/bash_login @@ -1,7 +1,7 @@ ################################################################################ # # File: $RCSfile: bash_login,v $ -# Revision: $Revision: 1.29 $ +# Revision: $Revision: 1.29 $ # Description: bash startup file # Author: Andrew@DeFaria.com # Created: Mon Aug 20 17:35:01 2001 @@ -48,12 +48,15 @@ else echo "Warning: Unknown architecture ($KERNEL)" fi -# Architectual differences (AKA Silly Sun) -if [ $ARCHITECTURE = "sun" ]; then - alias id=/usr/xpg4/bin/id - alias tr=/usr/xpg4/bin/tr - - export id=/usr/xpg4/bin/id +# Hack: Just set TERM to xterm +if [ $ARCHITECTURE = 'sun' ]; then + id=/usr/xpg4/bin/id + tr=/usr/xpg4/bin/tr + TERM=xtermc +else + id=id + tr=tr + TERM=xterm fi # Set colors @@ -90,14 +93,6 @@ else export SYSNAME="*Unknown Systemname*:" fi -# System dependencies -# Note: I don't like doing this but an alias doesn't work... -if [ $ARCHITECTURE = "sun" ]; then - id=/usr/xpg4/bin/id -else - id=id -fi - umask 002 if [ "$interactive" = "true" ]; then @@ -152,10 +147,14 @@ set -o monitor set +u # Shell options -if [ $ARCHITECTURE != 'Darwin' ]; then - if ! grep -qP '5\.(6|7|8|9|10)' /etc/*release; then - shopt -s autocd > /dev/null 2>&1 - shopt -s dirspell > /dev/null 2>&1 +if [ $ARCHITECTURE != 'Darwin' -a $ARCHITECTURE != 'sun' ]; then + ls /etc/*release > /dev/null 2>&1 + + if [ $? = 0 ]; then + if ! grep -qP '5\.(6|7|8|9|10)' /etc/*release; then + shopt -s autocd > /dev/null 2>&1 + shopt -s dirspell > /dev/null 2>&1 + fi fi fi @@ -221,6 +220,7 @@ if [ "$TERM" = "hpterm" -o \ "$TERM" = "sun-color" -o \ "$TERM" = "vt100" -o \ "$TERM" = "vt220" -o \ + "$TERM" = "xtermc" -o \ "$TERM" = "xterm" -o \ "$TERM" = "xterm-256color" -o \ "$TERM" = "cygwin" ]; then @@ -304,6 +304,6 @@ HOME=$saved_home export GIT_SSH=/usr/bin/ssh # Now go home (in case we were not autmatically cd'ed there) -if [ $(id -u) -ne 0 ]; then +if [ $($id -u) -ne 0 ]; then cd fi diff --git a/rc/clearcase b/rc/clearcase index f06a3e0..3317a01 100644 --- a/rc/clearcase +++ b/rc/clearcase @@ -4077,36 +4077,48 @@ function _object_selector () { fi } # _object_selector -complete -o default -F _scm scm ct - -complete -F _catcs catcs -complete -F _checkin ci -complete -F _deliver deliver -complete -F _endview endview -complete -F _lsactivity lsact -complete -F _lsbl lsbl -complete -F _lsproject lsproj -complete -F _lsfolder lsfolder llfolder -complete -F _lsstgloc lsstgloc -complete -F _lsstream lsstream llstream -complete -F _lsview lsview llview -complete -F _lsvob lsvob llvob -complete -F _merge merge -complete -F _mktag mktag -complete -F _mkview mkview -complete -F _rebase rebase -complete -F _rmtag rmtag -complete -F _rmview rmview -complete -F _setactivity setact -complete -F _setcs setcs -complete -F _setview setview -complete -F _startview startview -complete -F _space space -complete -F _register register -complete -F _uncheckout unco -complete -F _unregister unregister - -complete -F _object_selector -o nospace lstype -complete -F _object_selector -o nospace lltype -complete -F _object_selector -o nospace lslock -complete -F _object_selector -o nospace lllock +if [[ $BASH_VERSION = 2.05* || $BASH_VERSION = 4* ]]; then + complete -o default -F _scm scm ct + + complete -F _catcs catcs + complete -F _checkin ci + complete -F _deliver deliver + complete -F _endview endview + complete -F _lsactivity lsact + complete -F _lsbl lsbl + complete -F _lsproject lsproj + complete -F _lsfolder lsfolder llfolder + complete -F _lsstgloc lsstgloc + complete -F _lsstream lsstream llstream + complete -F _lsview lsview llview + complete -F _lsvob lsvob llvob + complete -F _merge merge + complete -F _mktag mktag + complete -F _mkview mkview + complete -F _rebase rebase + complete -F _rmtag rmtag + complete -F _rmview rmview + complete -F _setactivity setact + complete -F _setcs setcs + complete -F _setview setview + complete -F _startview startview + complete -F _space space + complete -F _register register + complete -F _uncheckout unco + complete -F _unregister unregister +else + : echo 'Clearcase command completion broken on old Sun Bash shells' +fi + +if [[ $BASH_VERSION = 4* ]]; then + complete -F _object_selector -o nospace lstype + complete -F _object_selector -o nospace lltype + complete -F _object_selector -o nospace lslock + complete -F _object_selector -o nospace lllock +elif [[ $BASH_VERSION = 2.05* ]]; then + complete -F _object_selector lstype + complete -F _object_selector lltype + complete -F _object_selector lslock + complete -F _object_selector lllock + #echo 'Clearcase command completion partially broken on old Sun Bash shells' +fi diff --git a/rc/clearcase.conf b/rc/clearcase.conf index 3e8c4f4..efd7c53 100644 --- a/rc/clearcase.conf +++ b/rc/clearcase.conf @@ -15,7 +15,7 @@ fi export LINUX_VOBTAG_PREFIX=/vob # The default pvob -export pvob=${VOBTAG_PREFIX}9200_projects +export pvob=${VOBTAG_PREFIX} # The default vob -export dvob="${VOBTAG_PREFIX}9200" +export dvob=${VOBTAG_PREFIX} diff --git a/rc/client_scripts/GD b/rc/client_scripts/GD index fb2993c..2d00db9 100644 --- a/rc/client_scripts/GD +++ b/rc/client_scripts/GD @@ -27,9 +27,9 @@ export ORACLE_HOME="/usr/local/oracle/product/9.2" export CCASE_MAKE_COMPAT=gnu -export CQ_HOME=/opt/rational/clearquest export CQ_HELP_BROWSER=firefox export CQ_PERLLIB=/opt/rational/common/lib/perl5/5.6.1/sun4-solaris-multi:/opt/rational/common/lib/perl5/5.6.1:/opt/rational/common/lib/perl5/site_perl/5.6.1/sun4-solaris-multi:/opt/rational/common/lib/perl5/site_perl/5.6.1:/opt/rational/common/lib/perl5/site_perl +export PERL5LIB=/cleartrig/ent/SNSD/muos/ccadm_tools/vobs/ranccadm/scripts/lib:$PERL5LIB export TZ="US/Arizona" @@ -37,7 +37,7 @@ alias xv=/prj/Synopsis/gccsparcOS5/ccss/utils/xv/xv export RSU_LICENSE_MAP="/prj/muosran/config/Rational_License_Map" -export LM_LICENSE_FILE="flex2:1850@flex2:15280@ranadm2:19353@ranadm2:19355@ranadm2:2468@ranadm2:1717@flex2:1711@bartlett:1711@flex3:27000@ranadm2:28000@ranadm2:5270@flex2" +export LM_LICENSE_FILE="1850@ma06app30:flex2:1850@flex2:15280@ranadm2:19353@ranadm2:19355@ranadm2:2468@ranadm2:1717@flex2:1711@bartlett:1711@flex3:27000@ranadm2:28000@ranadm2:5270@flex2" alias xemacs="ssh muosbldforge2 xemacs" @@ -46,9 +46,17 @@ export EDITOR="ssh muosbldforge2 xemacs" if [ $(uname) = "SunOS" ]; then export QTDIR=/usr/local/Trolltech/Qt-4.2.2 export ORACLE_HOME="/usr/local/oracle/product/9.2" - export CQ_HOME=/opt/rational/clearquest/ + export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:/usr/X11R6/lib:/usr/local/lib elif [ $(uname) = "Linux" ]; then export QTDIR=/usr/local/Trolltech/Qt-4.2.3 export ORACLE_HOME="/usr/local/oracle/product/10.2.0" export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:/usr/X11R6/lib -fi \ No newline at end of file +fi + +# Additional paths... +append_to_path "/c/Program Files/IBM/RationalSDLC/common" +append_to_path "/d/Program Files/IBM/RationalSDLC/common" +append_to_path "/c/Program Files/IBM/RationalSDLC/Clearquest/cqcli/bin" +append_to_path "/d/Program Files/IBM/RationalSDLC/Clearquest/cqcli/bin" +append_to_path "/c/Program Files/IBM/RationalSDLC/ClearCase/bin" +append_to_path "/d/Program Files/IBM/RationalSDLC/ClearCase/bin" diff --git a/rc/client_scripts/ICANN b/rc/client_scripts/ICANN old mode 100755 new mode 100644 diff --git a/rc/functions b/rc/functions index 88a4ba0..1f8dcdc 100644 --- a/rc/functions +++ b/rc/functions @@ -60,8 +60,9 @@ function title_bar { elif [ "$TERM" = "cygwin" -o \ "$TERM" = "vt100" -o \ "$TERM" = "xterm" -o \ + "$TERM" = "xtermc" -o \ "$TERM" = "xterm-256color" ]; then - PS1="\[\e]0;$prefix$current_dir\007\]\[$RED\]$ROOT\[$LIGHT_CYAN\]$SYSNAME:\[$WHITE\]" + PS1="\[\e]0;$prefix$current_dir\007\]$ROOT\[$B_YELLOW\]$SYSNAME:\[$B_WHITE\]" fi } # title_bar @@ -89,9 +90,9 @@ function title { # view and a string to indicate that you are root. function set_title { if [ $($id -u) -eq 0 ]; then - ROOT="Wizard " + root="Wizard " else - ROOT= + root= fi view_name=$(scm pwv -short 2> /dev/null); @@ -102,9 +103,9 @@ function set_title { if [[ $view_name = *NONE* ]]; then view_name="" - title_bar "$ROOT" + title_bar "$root" else - title_bar "${ROOT}View: $view_name: " + title_bar "${root}View: $view_name: " fi icon_name "${SYSNAME##*:}" @@ -113,17 +114,18 @@ function set_title { # Sets prompt on terminals listed. function set_prompt { if [ $($id -u) -eq 0 ]; then - if [ "$TERM" = "hpterm" -o \ - "$TERM" = "hp" -o \ - "$TERM" = "2392A" -o \ - "$TERM" = "dtterm" -o \ - ! -z "$DTTERM" ]; then - ROOT="${RED}Wizard$NORMAL " - elif [ "$TERM" = "vt100" -o \ - "$TERM" = "xterm" -o \ - "$TERM" = "xterm-256color" -o \ - "$TERM" = "vt220" ]; then - ROOT="${BOLD}${BLINK}Wizard$NORMAL " + if [ "$TERM" = "hpterm" -o \ + "$TERM" = "hp" -o \ + "$TERM" = "2392A" -o \ + "$TERM" = "dtterm" -o \ + "$TERM" = "vt100" -o \ + "$TERM" = "xterm" -o \ + "$TERM" = "xtermc" -o \ + "$TERM" = "xterm-256color" -o \ + "$TERM" = "vt220" ]; then + ROOT="\[${ROOT_COLOR}\]Wizard\[$NORMAL\] " + else + ROOT="Wizard " fi else ROOT="" @@ -131,9 +133,10 @@ function set_prompt { if [ "$TERM" = "vt100" -o \ "$TERM" = "xterm" -o \ + "$TERM" = "xtermc" -o \ "$TERM" = "xterm-256color" -o \ "$TERM" = "vt220" ]; then - PS1="$ROOT$BOLD$SYSNAME:$NORMAL" + PS1="$ROOT\[$B_YELLOW\]$SYSNAME:\[$B_WHITE\]" else PS1="$ROOT$SYSNAME:" fi diff --git a/rc/perldb b/rc/perldb index 54c75b2..cb016f4 100644 --- a/rc/perldb +++ b/rc/perldb @@ -1,2 +1,2 @@ parse_options ('windowSize=20'); -parse_options ('HistFile=.perldb.hist'); +#parse_options ('HistFile=.perldb.hist'); diff --git a/rc/set_colors b/rc/set_colors index 5b283de..b9e5425 100644 --- a/rc/set_colors +++ b/rc/set_colors @@ -30,28 +30,30 @@ if [ "$TERM" = "vt100" -o \ echo -e "${INVERSE}Inverse$NORMAL" fi elif [ "$TERM" = "dtterm" -o \ - "$TERM" = "xterm" ]; then - NORMAL="$esc[39m" - RED="$esc[31m" - B_RED=$RED - GREEN="$esc[32m" - B_GREEN=$GREEN - YELLOW="$esc[33m" - B_YELLOW=$YELLOW - BLUE="$esc[34m" - B_BLUE=$BLUE - MAGENTA="$esc[35m" - B_MAGENTA=$MAGENTA - AQUA="$esc[36m" - B_AQUA=$AQUA - WHITE="$esc[36m" - B_WHITE=$WHITE + "$TERM" = "xterm" -o \ + "$TERM" = "xtermc" ]; then + NORMAL="$esc[0;39m" + RED="$esc[0;31m" + B_RED="$esc[1;31m" + GREEN="$esc[0;32m" + B_GREEN="$esc[1;32m" + YELLOW="$esc[0;33m" + B_YELLOW="$esc[1;33m" + BLUE="$esc[0;34m" + B_BLUE="$esc[1;34m" + MAGENTA="$esc[0;35m" + B_MAGENTA="$esc[1;35m" + AQUA="$esc[0;36m" + B_AQUA="$esc[1;36m" + WHITE="$esc[0;37m" + B_WHITE="$esc[1;37m" + ROOT_COLOR="$esc[1;31m" if [ "$1" = "-v" ]; then echo "Terminal: $TERM" echo -e "${RED}Red$NORMAL\t${B_RED}Bright red$NORMAL" echo -e "${GREEN}Green$NORMAL\t${B_GREEN}Bright green$NORMAL" - echo -e "${YELLOW}Yellow$NORMAL\t${B_YELLOW}Bright green$NORMAL" + echo -e "${YELLOW}Yellow$NORMAL\t${B_YELLOW}Bright yellow$NORMAL" echo -e "${BLUE}Blue$NORMAL\t${B_BLUE}Bright blue$NORMAL" echo -e "${MAGENTA}Magenta$NORMAL\t${B_MAGENTA}Bright magenta$NORMAL" echo -e "${AQUA}Aqua$NORMAL\t${B_AQUA}Bright aqua$NORMAL" diff --git a/rc/set_path b/rc/set_path index b39caef..10a4179 100644 --- a/rc/set_path +++ b/rc/set_path @@ -85,6 +85,7 @@ path_dirs="$path_dirs\ /usr/local/bin\ /usr/afsws/bin\ /usr/afsws\ + /usr/xpg4/bin\ /bin\ /sbin\ /usr/bin\ @@ -95,6 +96,7 @@ path_dirs="$path_dirs\ /usr/openwin/bin\ /usr/kerberos/bin\ /opt/rational/clearcase/bin\ + /opt/rational/clearquest/bin\ /opt/ibm/rationalsdlc/clearcase/bin\ /opt/ibm/rationalsdlc/clearcase/etc\ /opt/ibm/rationalsdlc/clearquest/bin\ diff --git a/rc/system b/rc/system index 7f16ea4..03a1fb3 100644 --- a/rc/system +++ b/rc/system @@ -23,7 +23,7 @@ SYSNAME=$(echo ${SYSNAME:0:1} | tr [:lower:] [:upper:])$(echo ${SYSNAME:1} | t # Aliasing case "$SYSNAME" in - C02s608vg8wp) + Az25jzhxkb2d) SYSNAME="Venus" ;; esac diff --git a/test/testclearcase.conf b/test/testclearcase.conf new file mode 100755 index 0000000..c240d95 --- /dev/null +++ b/test/testclearcase.conf @@ -0,0 +1,21 @@ +################################################################################ +# +# File: testcc.conf +# Revision: 2.0 +# Description: Parameters for testcc +# +# Author: Andrew@DeFaria.com +# Created: Thu Sep 6 14:05:55 MST 2007 +# Modified: +# Language: Conf +# +# (c) Copyright 2007, Andrew@DeFaria.com, all rights reserved. +# +################################################################################# +vobhost: gdvob1 +vobpath: /net/$vobhost +vobstore: $vobpath/local/gdvob1a + +viewhost: view2 +viewpath: /net/$viewhost +viewstore: $viewpath/local/view2c diff --git a/test/testclearcase.pl b/test/testclearcase.pl index f0cfde9..42e3152 100755 --- a/test/testclearcase.pl +++ b/test/testclearcase.pl @@ -1,68 +1,877 @@ -#!/usr/bin/perl +#!/usr/bin/env cqperl + +=pod + +=head1 NAME $RCSfile: testclearcase.pl,v $ + +Test Clearcase + +=head1 VERSION + +=over + +=item Author + +Andrew DeFaria + +=item Revision + +$Revision: 2.1 $ + +=item Created: + +Tue Apr 10 13:14:15 CDT 2007 + +=item Modified: + +$Date: 2011/01/09 01:01:32 $ + +=back + +=head1 SYNOPSIS + + Usage: testclearcase.pl: [-us|age] [-ve|rbose] + [-c|onfig ] [-b|ase] [-uc|m] + + Where: + -v|erbose: Display progress output + -d|ebug: Display debug info + -us|age: Display usage + + -c|onfig : Config file (Default: testclearcase.conf) + -[no]b|ase: Perform base Clearcase tests (Default: base) + -[no]uc|m: Perform UCM Clearcase tests (Default: noucm) + -[no]clean: Cleanup after yourself (Default: clean) + +=head1 DESCRIPTION + +Clearcase smoke tests. Perform simple Clearcase operations to validate that +Clearcase minimally works. + +If -ucm is specified then additional UCM related tests are performed. + +=cut + use strict; use warnings; +use Cwd; use FindBin; +use Getopt::Long; use Term::ANSIColor qw(:constants); -my $libs; +use lib "$FindBin::Bin/../lib"; -BEGIN { - $libs = $ENV{SITE_PERLLIB} ? $ENV{SITE_PERLLIB} : "$FindBin::Bin/../lib"; - - die "Unable to find libraries\n" - unless -d $libs; -} # BEGIN +use Clearcase; +use Clearcase::Element; +use Clearcase::View; +use Clearcase::Views; +use Clearcase::Vob; +use Clearcase::Vobs; -use lib $libs; +use Clearcase::UCM; +use Clearcase::UCM::Activity; +use Clearcase::UCM::Baseline; +use Clearcase::UCM::Component; +use Clearcase::UCM::Folder; +use Clearcase::UCM::Project; +use Clearcase::UCM::Pvob; +use Clearcase::UCM::Stream; -use Clearcase; +use DateUtils; use Display; +use GetConfig; +use Logger; +use OSDep; +use TimeUtils; +use Utils; + +# Globals +my $VERSION = '2.1'; + +my (@ucmobjs, $order); + +my ( + $test_vob, + $test_view, + $test_pvob, + $test_folder, + $test_project, + $test_activity, + $test_baseline, + $test_component,, + $test_devstream, + $test_intstream, + $test_devview, + $test_intview, +); + +my ($vbs, $vws, %default_opts, %opts); + +my ($script) = ($FindBin::Script =~ /^(.*)\.pl/); + +my $log = Logger->new; + +# LogOpts: Log the %opts has to the log file so we can tell the options used for +# this run. +sub LogOpts() { + $log->msg( + "$script v$VERSION run at " + . YMDHM + . ' with the following options:' + ); + + for (sort keys %opts) { + if (ref $opts{$_} eq 'ARRAY') { + my $name = $_; + $log->msg("$name:\t$_") for (@{$opts{$_}}); + } else { + $log->msg("$_:\t$opts{$_}"); + } # if + } # for + + return; +} # LogOpts + +sub CreateVob($) { + my ($tag) = @_; + + my $vobname = Clearcase::vobname $tag; + + $log->msg ("Creating vob $tag"); + + my $newvob = Clearcase::Vob->new($tag); + + my ($status, @output) = $newvob->create($opts{vobhost}, "$opts{vobstore}/$vobname.vbs"); + + $log->log($_) for (@output); + + return ($status, $newvob); +} # CreateVob + +sub CreatePvob($) { + my ($tag) = @_; + + my $vobname = Clearcase::vobname $tag; + + my $pvob = Clearcase::UCM::Pvob->new($tag); + + #my ($status, @output) = $pvob->create($opts{vobhost}, "$opts{vobstore}/$vobname.vbs", 'A test Pvob'); + my ($status, @output) = $pvob->create($opts{vobhost}, "$opts{vobstore}/$vobname.vbs"); + + $log->log($_) for (@output); + + push @ucmobjs, $pvob unless $status; + + return ($status, $pvob); +} # CreatePvob + +sub MountVob($) { + my ($vob) = @_; + + $log->msg('Mounting vob ' . $vob->tag); + + # Create mount directory + my ($status, @output); + + ($status, @output) = Execute 'mkdir -p ' . $vob->tag . ' 2>&1' unless -d $vob->tag; + + $log->log($_) for (@output); + + ($status, @output) = $vob->mount; + + $log->log($_) for (@output); + + return $status; +} # MountVob + +sub DestroyVob($) { + my ($vob) = @_; + + my ($status, @output); + + ($status, @output) = $Clearcase::CC->execute('cd'); + + $log->msg('Unmounting vob ' . $vob->tag); + + ($status, @output) = $vob->umount; + + $log->msg('Removing vob ' . $vob->tag); + + ($status, @output) = $vob->remove; + + $log->log($_) for (@output); + + return $status; +} # DestroyVob + +sub CreateView($) { + my ($tag) = @_; + + $log->msg("Creating view $tag"); + + my $view = Clearcase::View->new($tag); + + my ($status, @output) = $view->create($opts{viewhost}, "$opts{viewstore}/$tag.vws"); -my ($status, @output) = $Clearcase::CC->execute ('-ver'); + $log->log($_) for (@output); -error 'Clearcase is not installed on this system', 1 - if $status; + return ($status, $view); +} # CreateView + +sub SetView($) { + my ($view) = @_; + + $log->msg('Setting view ' . $view->tag); + + my ($status, @output) = $view->set; + + $log->log($_) for (@output); + + return $status; +} # SetView + +sub DestroyView($) { + my ($view) = @_; + + $log->msg('Removing view ' . $view->tag); + + my ($status, @output) = $Clearcase::CC->execute('cd'); + + $log->log($_) for (@output); + + chdir $ENV{HOME} + or $log->err("Unable to chdir $ENV{HOME}", 1); + + ($status, @output) = $view->remove; + + $log->log($_) for (@output); + + return $status; +} # DestroyView + +sub CreateViewPrivateFiles(@) { + my (@elements) = @_; + + $log->msg('Creating test files'); + + for (@elements) { + my $file; + + $log->msg("Creating $_"); + + open $file, '>>', $_ + or $log->err("Unable to open $_ for writing - $!", 1); + + print $file "This is file $_\n"; + + close $file; + } # for + + return; +} # CreateViewPrivateFiles + +sub CheckOut($) { + my ($element) = @_; + + my ($status, @output); + + if (ref $element eq 'ARRAY') { + for (@{$element}) { + $log->msg("Checking out $_"); + + my $newElement = Clearcase::Element->new($_); + + ($status, @output) = $newElement->checkout; + + $log->log($_) for (@output); + + $log->err("Unable to check out $_", $status) if $status; + } # for + } else { + $log->msg("Checking out $element"); + + my $newElement = Clearcase::Element->new($element); + + ($status, @output) = $newElement->checkout; + + $log->log($_) for (@output); + + $log->err("Unable to check out $element", $status) if $status; + } # if + + return; +} # CheckOut + +sub CheckIn($) { + my ($element) = @_; + + my ($status, @output); + + if (ref $element eq 'ARRAY') { + for (@{$element}) { + $log->msg("Checking in $_"); + + my $newElement = Clearcase::Element->new($_); + + ($status, @output) = $newElement->checkin; + + $log->log($_) for (@output); + + $log->err("Unable to check in $_", $status) if $status; + } # for + } else { + $log->msg("Checking in $element"); + + my $newElement = Clearcase::Element->new($element); + + ($status, @output) = $newElement->checkin; + + $log->log($_) for (@output); + + $log->err("Unable to check in $element", $status) if $status; + } # if -display YELLOW . "Global Clearcase Variables\n" . RESET; + return; +} # CheckIn + +sub ComparingFiles(@) { + my (@elements) = @_; + + for (@elements) { + my @lines = ReadFile $_; + + $log->err("Element $_ should contain only two lines", 2) if scalar @lines != 2; + } # for + + return; +} # ComparingFiles + +sub MakeElements(@) { + my (@elements) = @_; + + for (@elements) { + $log->msg("Mkelem $_"); + + my $newElement = Clearcase::Element->new($_); + + my ($status, @output) = $newElement->mkelem; + + $log->log($_) for (@output); + + $log->err("Unable to make $_ an element", $status) if $status; + } # for + + return; +} # MakeElements + +sub RunTests() { + # Simple tests: + # + # . Create a few elements + # . Check them in + # . Check them out + # . Modify them + # . Check them in + # + # Assumptions: + # + # . $vob_tag is already created + # . $view_tag is already created + # . View is set and we are in the vob + # . There are no vob elements for @elements + my @elements = ( + 'cctest.h', + 'ccsetup.c', + 'cctest.c', + 'Makefile', + ); + + $log->msg("$script: Start Base Clearcase Tests"); + $log->msg('Removing test files'); + + unlink $_ for (@elements); + + $log->msg('Creating view private files'); + + CreateViewPrivateFiles @elements; + + $log->msg('Making elements'); + + CheckOut '.'; + MakeElements @elements; + CheckIn \@elements; + CheckIn '.'; + + $log->msg('Checking out files'); + + CheckOut \@elements; + + $log->msg('Modifying files'); + + CreateViewPrivateFiles @elements; + + $log->msg('Checking in files'); + + CheckIn \@elements; + + $log->msg('Comparing files'); + + ComparingFiles @elements; + + $log->msg("$script: End Base Clearcase Tests"); + + return 0; +} # RunTests + +sub Cleanup(;$$$) { + my ($view, $vob) = @_; + + my $status = 0; + + $log->msg('Cleaning up'); + + if ($view && $view->exists) { + $status += DestroyView($view); + } # if + + if ($vob && $vob->exists) { + $status += DestroyVob($vob); + } # if + + return $status; +} # Cleanup + +sub CleanupUCM() { + my $status = 0; + + # Need to remove UCM objects in the opposite order in which we created them + for (reverse @ucmobjs) { + my ($rc, @output); + + if (ref $_ eq 'Clearcase::UCM::Pvob') { + $log->msg('Removing Pvob ' . $_->tag); + + $status += DestroyVob $_; + } else { + $log->msg('Removing ' . ref ($_) . ' ' . $_->name); + + ($rc, @output) = $_->remove; + + $status += $rc; + } # if + } # for + + return $status; +} # CleanupUCM + +sub SetupTest($$) { + my ($vob_tag, $view_tag) = @_; + + my ($status, @output); + + $log->msg('Setup test environment'); + + my $view = Clearcase::View->new($view_tag); + + if ($view->exists) { + $log->msg('Removing old view ' . $view_tag); + + ($status, @output) = $view->remove; + + $log->err('Unable to remove old view ' . $view->tag, $status) if $status; + } # if + + ($status, $test_view) = CreateView($view_tag); + + return $status if $status != 0; + + $status = $test_view->start; + + my $vob = Clearcase::Vob->new($vob_tag); + + if ($vob->exists) { + $log->msg('Removing old vob ' . $vob_tag); + + ($status, @output) = DestroyVob($vob); + + $log->err('Unable to remove old vob '. $vob->tag, $status) if $status; + } # if + + ($status, $test_vob) = CreateVob($vob_tag); + + return $status if $status != 0; + + $status = MountVob($test_vob); + + return $status if $status != 0; + + my $dir = $Clearcase::VIEWTAG_PREFIX . '/' . $test_view->tag . $test_vob->tag; + + chdir $dir + or $log->err("Unable to chdir to $dir", ++$status); + + ($status, @output) = $Clearcase::CC->execute("cd $dir"); + + if ($status != 0) { + $log->log($_) for (@output); + } # if + + return $status; +} # SetupTest + +sub SetupUCMTest() { + my $status; + + $log->msg("Creating UCM Pvob $Clearcase::VOBTAG_PREFIX/tc.pvob"); + + ($status, $test_pvob) = CreatePvob("$Clearcase::VOBTAG_PREFIX/tc.pvob"); + + return $status; +} # SetupUCMTest + +sub CreateUCMProject() { + # Get the root folder to put this project into (may create folders later) + my $folder = Clearcase::UCM::Folder->new('tc.folder', $test_pvob); + + $test_project = Clearcase::UCM::Project->new('tc.project', $folder, $test_pvob); + + $log->msg('Creating UCM Project tc.project'); + + my ($status, @output) = $test_project->create(); + + $log->log($_) for (@output); + + push @ucmobjs, $test_project unless $status; + + return $status; +} # CreateUCMProject + +sub CreateUCMIntStream() { + $test_intstream = Clearcase::UCM::Stream->new('tc.intstream', $test_pvob); + + $log->msg('Creating UCM Stream tc.intstream'); + + my ($status, @output) = $test_intstream->create($test_project, '-integration'); + + $log->log($_) for (@output); + + push @ucmobjs, $test_intstream unless $status; + + return $status; +} # CreateUCMIntStream + +sub CreateUCMDevStream() { + $test_devstream = Clearcase::UCM::Stream->new('tc.devstream', $test_pvob); + + $log->msg('Creating UCM Stream tc.devstream'); + + my ($status, @output) = $test_devstream->create($test_project); + + $log->log($_) for (@output); + + push @ucmobjs, $test_devstream unless $status; + + return $status; +} # CreateUCMIntStream + +sub CreateUCMComponent() { + $test_component = Clearcase::UCM::Component->new('tc.component', $test_pvob); + + $log->msg('Creating UCM Component tc.component'); + + my ($status, @output) = $test_component->create( + "$Clearcase::VIEWTAG_PREFIX/" . $test_intview->tag . $test_vob->tag + ); + + $log->log($_) for (@output); + + push @ucmobjs, $test_component unless $status; + + return $status; +} # CreateUCMComponent + +sub AddModifiableComponent() { + my ($status, @output) = $Clearcase::CC->execute( + 'chproj -nc -amodcomp ' . $test_component->name . '@' . $test_pvob->tag . + ' ' . $test_project->name . '@' . $test_pvob->tag + ); + + $log->log($_) for (@output); + + return $status; +} # AddModifiableCOmponent + +sub CreateUCMIntView() { + $log->msg("Creating UCM Int View tc.intview"); + + $test_intview = Clearcase::View->new('tc.intview'); + + my ($status, @output) = $test_intview->create( + $opts{viewhost}, "$opts{viewstore}/tc.intview.vws", + '-stream ' . $test_intstream->name . '@' . $test_pvob->tag + ); + + $log->log($_) for (@output); + + push @ucmobjs, $test_intview unless $status; + + $test_intview->start unless $status; + + return $status; +} # CreateUCMIntView + +sub CreateUCMDevView() { + $log->msg("Creating UCM Dev View tc.devview"); + + $test_devview = Clearcase::View->new('tc.devview'); + + my ($status, @output) = $test_devview->create( + $opts{viewhost}, "$opts{viewstore}/tc.devview.vws", + '-stream ' . $test_devstream->name . '@' . $test_pvob->tag + ); + + $log->log($_) for (@output); + + push @ucmobjs, $test_devview unless $status; + + $test_devview->start unless $status; + + return $status; +} # CreateUCMDevView + +sub CreateUCMBaseline() { + $test_baseline = Clearcase::UCM::Baseline->new('tc.baseline', $test_pvob); + + $log->msg('Creating UCM Baseline tc.baseline'); + + my ($status, @output) = $test_baseline->create($test_intview, undef, '-identical'); + + $log->log($_) for (@output); + + push @ucmobjs, $test_baseline unless $status; + + return $status; +} # CreateUCMBaseline + +sub CreateUCMActivity() { + $test_activity = Clearcase::UCM::Activity->new('tc.activity', $test_pvob); + + $log->msg('Creating UCM Activity tc.activity'); + + my ($status, @output) = $test_activity->create($test_devstream, 'A UCM Test Activity'); + + $log->log($_) for (@output); + + push @ucmobjs, $test_activity unless $status; + + return $status; +} # CreateUCMActivity + +sub RebaseStream($$;$) { + my ($stream, $baseline, $opts) = @_; + + my ($status, @output) = $stream->rebase($baseline, $opts); + + $log->log($_) for (@output); + + return $status; +} # RebaseStream + +sub RecommendBaseline($) { + my ($baseline) = @_; + + my ($status, @output) = $test_intstream->recommend($baseline); + + $log->log($_) for (@output); + + return $status; +} # RecommentBaseline + +sub RunUCMTests() { + my $status = 0; + + $log->msg("$script: Start UCM Clearcase Tests"); + + $status += CreateUCMProject; + $status += CreateUCMIntStream; + $status += CreateUCMDevStream; + $status += CreateUCMIntView; + $status += CreateUCMDevView; + $status += CreateUCMComponent; + $status += AddModifiableComponent; + $status += RebaseStream($test_intstream, 'tc.component_INITIAL', '-complete'); + $status += RecommendBaseline('tc.component_INITIAL'); + $status += CreateUCMBaseline; + $status += RebaseStream($test_devstream, 'tc.baseline', '-complete'); + $status += CreateUCMActivity; + + $log->msg("$script: End UCM Clearcase Tests"); + + return $status; +} # RunUCMTests + +## Main +my $startTime = time; +my $conf_file = "$FindBin::Bin/$script.conf"; +my $status = 0; + +$opts{base} = 1; +$opts{clean} = 1; + +GetOptions( + \%opts, + 'verbose' => sub { set_verbose }, + 'debug' => sub { set_debug }, + 'usage' => sub { Usage }, + 'config=s', + 'base!', + 'ucm!', + 'clean!', +) or Usage; + +# Read the config file +if (-f $conf_file) { + %default_opts = GetConfig $conf_file; +} else { + $log->err("Unable to find config file $conf_file", 1); +} # if + +# Overlay default opts if not specified +for (keys %default_opts) { + $opts{$_} = $default_opts{$_} if !$opts{$_}; +} # for + +$log->msg("$script: Start"); + +LogOpts; + +# Since we are creating private vobs (to avoid complications with having to +# know and code the registry password when making public vobs), we'll simply +# change $Clearcase::VOBTAG_PREFIX +$Clearcase::VOBTAG_PREFIX = $ENV{TMP} || '/tmp'; + +if ($opts{base}) { + $status = SetupTest "$Clearcase::VOBTAG_PREFIX/tc.vob", 'tc.view'; + + if ($status == 0) { + $status += RunTests; + } else { + $log->err('Tests not run. Failure occurred in SetupTest - check logfile'); + } # if + + # Note if we are doing UCM tests then we need the view and vob here... + $status += Cleanup($test_view, $test_vob) if $opts{clean} and !$opts{ucm}; + + if ($status != 0) { + $log->err("$script: Failed (Base Clearcase)"); + } else { + $log->msg("$script: Passed (Base Clearcase)"); + } # if +} # if + +if ($opts{ucm}) { + $status = SetupUCMTest; + + if ($status == 0) { + $status += RunUCMTests; + } else { + $log->err('UCM Tests not run. Failure occurred in SetupUCMTest - check logfile'); + } # if + + if ($opts{clean}) { + $status += CleanupUCM; + $status += Cleanup($test_view, $test_vob); + } # if + + if ($status != 0) { + $log->err("$script Failed (UCM Clearcase)"); + } else { + $log->msg("$script: Passed (UCM Clearcase)"); + } # if +} # if + +display_duration $startTime, $log; + +$log->msg("$script: End"); + +exit $status; + +=pod + +=head1 CONFIGURATION AND ENVIRONMENT + +DEBUG: If set then $debug is set to this level. + +VERBOSE: If set then $verbose is set to this level. + +TRACE: If set then $trace is set to this level. + +=head1 DEPENDENCIES + +=head2 Perl Modules + +L + +L + +L + +L -my $view_drive = $Clearcase::VIEW_DRIVE; -my $vob_mount = $Clearcase::VOB_MOUNT; -my $win_vob_prefix = $Clearcase::WIN_VOB_PREFIX; -my $vobtag_prefix = $Clearcase::VOBTAG_PREFIX; -my $countdb = $Clearcase::COUNTDB; +=head2 ClearSCM Perl Modules -display MAGENTA . "View Drive:\t\t" . RESET . $view_drive; -display MAGENTA . "VOB Mount:\t\t" . RESET . $vob_mount; -display MAGENTA . "Windows VOB prefix:\t" . RESET . $win_vob_prefix; -display MAGENTA . "VOB Tag Prefix:\t\t" . RESET . $vobtag_prefix; -display MAGENTA . "CountDB:\t\t" . RESET . $countdb; +=begin man -display CYAN . "\nGlobal Clearcase Configuration\n" . RESET; + Clearcase + Clearcase::Element + Clearcase::View + Clearcase::Views + Clearcase::Vob + Clearcase::Vobs + DateUtils + Display + GetConfig + Logger + OSDep + Utils -display MAGENTA . "Client:\t\t\t" . RESET . $Clearcase::CC->client; -display MAGENTA . "Hardware type:\t\t" . RESET . $Clearcase::CC->hardware_type; -display MAGENTA . "License host:\t\t" . RESET . $Clearcase::CC->license_host; -display MAGENTA . "OS:\t\t\t" . RESET . $Clearcase::CC->os; -display MAGENTA . "Region:\t\t\t" . RESET . $Clearcase::CC->region; -display MAGENTA . "Registry host:\t\t" . RESET . $Clearcase::CC->registry_host; -display MAGENTA . "Sitename:\t\t" . RESET . $Clearcase::CC->sitename; -display MAGENTA . "Version:\t\t" . RESET . $Clearcase::CC->version; +=end man -display GREEN . "\nCleartool Access\n" . RESET; +=begin html -display_nolf MAGENTA . "Views:\t" . RESET; +
+Clearcase
+Element
+View
+Views
+Vob
+Vobs
+UCM
+Activity
+Baseline
+Component
+Project
+Pvob
+Stream
+DateUtils
+Display
+GetConfig
+Logger
+OSDep
+Utils
+
-($status, @output) = $Clearcase::CC->execute ("lsview -s"); +=end html -display scalar @output; +=head1 BUGS AND LIMITATIONS -display_nolf MAGENTA . "VOBs:\t" . RESET; +There are no known bugs in this script -($status, @output) = $Clearcase::CC->execute ("lsvob -s"); +Please report problems to Andrew DeFaria . -display scalar @output; +=head1 LICENSE AND COPYRIGHT -($status, @output) = $Clearcase::CC->execute ("invalid command"); +Copyright (c) 2010, ClearSCM, Inc. All rights reserved. -display $_ foreach (@output); +=cut diff --git a/test/testclearquest.pl b/test/testclearquest.pl index c659f32..9870e21 100755 --- a/test/testclearquest.pl +++ b/test/testclearquest.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!/usr/bin/env cqperl use strict; use warnings; @@ -118,27 +118,28 @@ use lib "$FindBin::Bin/../lib"; use Clearquest; use Display; +use Logger; use TimeUtils; use Utils; -my ($cq, %opts); +my ($cq, %opts, $log); sub displayRecord (%) { my (%record) = @_; - display '-' x 79; + $log->msg ('-' x 79); - foreach (keys %record) { - display_nolf "$_: "; + for (keys %record) { + $log->msg ("$_: ", 1); if (ref $record{$_} eq 'ARRAY') { - display join ", ", @{$record{$_}}; + $log->msg (join ", ", @{$record{$_}}); } elsif ($record{$_}) { - display $record{$_}; + $log->msg ($record{$_}); } else { - display ""; + $log->msg (''); } # if - } # foreach + } # for return; } # displayRecord @@ -149,7 +150,7 @@ sub displayResults (@) { if (@records) { displayRecord %$_ foreach (@records); } else { - display "Did not find any records"; + $log->msg ('Did not find any records'); } # if return; @@ -160,11 +161,11 @@ sub testGetRecord ($$;@) { my $startTime = time; - display "Testing get table: $table key: $key"; + $log->msg ("Testing get table: $table key: $key"); displayRecord $cq->get ($table, $key, @fields); - display_duration $startTime; + display_duration $startTime, $log; return; } # testGetRecord @@ -174,17 +175,17 @@ sub testFindRecord ($$;@) { my $startTime = time; - display "Testing find table: $table condition: $condition"; + $log->msg ("Testing find table: $table condition: $condition"); my ($result, $nbrRecs) = $cq->find ($table, $condition, @fields); - display "$nbrRecs records qualified"; + $log->msg ("$nbrRecs records qualified"); - while (my %record = $cq->getNext ($result)) { + while (my %record = $cq->getNext($result)) { displayRecord %record; } # while - display_duration $startTime; + display_duration $startTime, $log; return; } # testFindRecord @@ -194,13 +195,13 @@ sub testModifyRecord ($$;%) { my $startTime = time; - display "Testing modify table: $table key: $key"; + $log->msg ("Testing modify table: $table key: $key"); $cq->modify ($table, $key, undef, \%update); $cq->checkErr; - display_duration $startTime; + display_duration $startTime, $log; return; } # testModifyRecord @@ -226,13 +227,13 @@ sub testChangeState ($$) { $update{Stability_Issue} = 'Assert'; } # if - display "Testing change state table: $table key: $key action: $action"; + $log->msg ("Testing change state table: $table key: $key action: $action"); $cq->modify ($table, $key, $action, \%update); $cq->checkErr; - display_duration $startTime; + display_duration $startTime, $log; return; } # testChangeState @@ -242,13 +243,13 @@ sub testAddRecord ($%) { my $startTime = time; - display "Testing adding table: $table"; + $log->msg ("Testing adding table: $table"); - $cq->add ($table, \%record, qw(Projects VersionStr)); + $cq->add ($table, \%record); $cq->checkErr; - display_duration $startTime; + display_duration $startTime, $log; return; } # testAddRecord @@ -258,13 +259,13 @@ sub testDeleteRecord ($$) { my $startTime = time; - display "Testing deleting table: $table key: $key"; + $log->msg ("Testing deleting table: $table key: $key"); $cq->delete ($table, $key); $cq->checkErr; - display_duration $startTime; + display_duration $startTime, $log; return; } # testDeleteRecord @@ -318,57 +319,61 @@ $opts{add} = 1 if $opts{delete}; my $startTime = time; +$log = Logger->new; + $cq = Clearquest->new (%opts); -display_nolf 'Connecting to Clearquest database ' . $cq->connection; +$log->msg ('Connecting to Clearquest database ' . $cq->connection, 1); unless ($cq->connect) { - $cq->checkErr ('Unable to connect to database ' . $cq->connection); + $cq->checkErr ('Unable to connect to database ' . $cq->connection, undef, $log); if ($cq->module eq 'client') { - display 'Unable to connect to server ' - . $cq->server () - . ':' - . $cq->port (); + $log->msg ('Unable to connect to server ' . $cq->server () . ':' . $cq->port ()); } # if exit $cq->error; } else { - display ''; - display_duration $startTime; + $log->msg (''); + display_duration $startTime, $log; } # unless $cq->setOpts (emptyStringForUndef => 1); if ($opts{get}) { # Get record by key - testGetRecord 'Project', 'Athena'; + testGetRecord 'WOR', 'XTST100000019'; # Get record by condition - testFindRecord 'VersionInfo', 'Deprecated = 1'; + testFindRecord 'WOR', 'Owner = "ccadm"'; # Get record by key with field list - testFindRecord 'VersionInfo', 'VersionStr = 1.0', ('VersionStr', 'Deprecated'); + testFindRecord 'WOR', 'Owner = "ccadm"', ('id', 'Headline', 'Owner'); # Get record by condition with field list - testFindRecord 'CategorySub', 'Category="Software"', ('Category', 'CategoryType', 'SubCategory'); + testFindRecord 'WOR', 'Owner = "ccadm"', ('id', 'Headline', 'Owner'); } # if if ($opts{add}) { # Add a record - testAddRecord 'VersionInfo', ( - VersionStr => '2.0', - Projects => ['Island', '21331', 'Hera'], - Visibility => 'Nokia Corporation', + testAddRecord 'Component', ( + Name => $FindBin::Script, + Description => 'This is a test component', ); } # if if ($opts{modify}) { # Modify a record - testModifyRecord ('VersionInfo', '1.0', ( - Deprecated => 1, - Projects => ['Island', 'Athena'], - )); + my $newDescription = 'This is a modified test component'; + + testModifyRecord ('Component', $FindBin::Script, (Description => $newDescription)); + + # Make sure the modification happened + my %component = $cq->get ('Component', $FindBin::Script, ('Description')); + + if ($component{Description} ne $newDescription) { + $log->err ('Modification of Component.Description failed!'); + } # if } # if if ($opts{change}) { @@ -378,9 +383,9 @@ if ($opts{change}) { if ($opts{add}) { # Delete that record - testDeleteRecord 'VersionInfo', '2.0'; + testDeleteRecord 'Component', $FindBin::Script; } # if -display_nolf 'Total process time '; +$log->msg ('Total process time ', 1); -display_duration $processStartTime; +display_duration $processStartTime, $log; diff --git a/test/testspreadsheet.pl b/test/testspreadsheet.pl old mode 100755 new mode 100644 diff --git a/test/testspreadsheet.xls b/test/testspreadsheet.xls old mode 100644 new mode 100755 -- 2.17.1