From af2863f60892b60b0f8d94322c8502943a9c0329 Mon Sep 17 00:00:00 2001 From: su-fang Date: Tue, 27 Sep 2022 15:13:04 +0800 Subject: [PATCH] Import Upstream version 0.03 --- Changes | 11 + Iterator-ppm.tar.gz | Bin 0 -> 8918 bytes Iterator.pm | 832 ++++++++++++++++++++++++++++++++++++++++++++ Iterator.ppd | 12 + MANIFEST | 11 + META.yml | 12 + Makefile.PL | 63 ++++ README | 83 +++++ t/doc.t | 85 +++++ t/new.t | 109 ++++++ t/value.t | 170 +++++++++ 11 files changed, 1388 insertions(+) create mode 100644 Changes create mode 100644 Iterator-ppm.tar.gz create mode 100644 Iterator.pm create mode 100644 Iterator.ppd create mode 100644 MANIFEST create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100644 t/doc.t create mode 100644 t/new.t create mode 100644 t/value.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..196da3f --- /dev/null +++ b/Changes @@ -0,0 +1,11 @@ +Revision history for Perl extension Iterator. + +0.01 2005 August 18 + - First version + +0.02 2005 August 23 + - Fixed several documentation typos. + +0.03 2005 October 10 + - Minor change to suppress a warning with newer versions of + Exception::Class. diff --git a/Iterator-ppm.tar.gz b/Iterator-ppm.tar.gz new file mode 100644 index 0000000000000000000000000000000000000000..c0f8ec4196758a860975d46d2a45ebf36618159b GIT binary patch literal 8918 zcmV;{A}QS;iwFQ~x=KR=1MFLQbK6Fi_uu^~Ip<*%~TtpA(He`jOwyZrwO`L|M? zsMI9uf35s?_jWhG%m1&G|C)Xu+SGm-`EPD)?CtD)K>k~MyZif~D0?t|e{+BPk=*z$ z|8FDzuN(t@Lj1SCz4P7vzp4Dcq``l-{qJn;eYgK_EB~(-{(YqVZ(#htzp?$@{=dEa zze@P`3G(0F+5e9Jf2I7ts5kh8_zy;W$Nz6C|6KHIqv6-^|2qrizXvA2&-TB)x4pl& zgZ2+IzRUkxe2#i1k^NC$tm5bAvuCYy`Rds#dD(h)es(Hfo?TuZKRctB;<>Ve19|!U zcvFa@fmXq$JU@PUCPc0~a#bG7zK-FqXmyk&BV)A;^OxO7S-a+^{`cAI%htuY5LbiH z%D{B9p^j6Ph9;JQw%sJ`Xe)1YV)4nw+QzmtJy}xIhP>#erlS+NxzUhY8yma0csEOh z$Y5WaCSf-{q~FIXiNm;W55-7zuT@|BbqMS;HT4C13pD;D1)+QIj6t(og*G;dsHLrd)Z33=6xSq+-97 z22Hwa%q)9w@Jc0WsNqTbEJ;iII8F6%lpM^upu--e$?NZ>{M+AT<=r%A*58-d=QzFum`QXS-_X`;diP18bb2oYy3 zvmCJyCikmq__ zcoBH*jfY3v7tYGsO{io$i~&#qg#Xla(kkRtp+9qg&#M(Yej6Bhiw{(6;>plt_KpX2 zB9JSOYq(YTg%f6J+uGB1y{daSgd}?lY6Of>Bb!Cc2KXy7HcPZ{&H;iy$YQco+k>3C z{~*3X(sk&)GC3(-FcwG18vX?K*Ci%sT7jeFm~73j6hb_a2V{r&NY(U^(x4E2!?L16=rI(ll6Mwt>@D5SpEa-aAGo$gc1#IQl6e&UcJ8f{hv9nrmUhQ12Qj(wLgJ#0R zKHpS$ooRD17^3#`w;y3GZpPH-zNp;IfGxG(U&>zy&RwWCG(i?ov<$gQG+CR!$q8tL zwj4Bt35cB&91wnm72qVM^o`d;qn;LZHM*JOBtFEB)g}e~wRg8y#>gI^kWXSMCaVH! z{jM&`Cjxzb+Llk`=HVx7Hbjr|@w+w4yAiY@2F!$X51>N=A^y#r?d1?q0F9A$0HpF3bItcKP(5iHF!{Ru5kCK%TuN1v zV*Frwy>dPe(0i>WRr<@2T~J?=eG!N2$P$%L7wvqXd3$AW;S=U`OUqA}8bW^Tr%1bT z5g?~b>{POm=MwWF-68&bIIn?^*7bV<8*)@1(tHkHpTka{1i|HrQ^?thZ_G7F9lIz) zKzfXbCrHIeC(#1ve61;oX7C&+3#o7n{t_N!Sjd9O_@e4$kqsJzT0tu^KL#916 z$wb0AbTSUDE?~CI{`(-dC<#Qsv%=DyzRnJqqtvs5=34Ik`a+`@IR8>D?Wi0I(4*QS z&+nwoVNAtQc~^}!A{g`aGz_7Twr*gBz(ocu?n)Yk0Q`_pz=PF%#r#$45g<`ah&xtE zu!?~l!c`fEE1r73s=;U4gG))Jd#uS6v&wTrS6PvChhA94?f& z(20+a5=yY1yKGZ0NX3-WIp|e3x2!wAw6kA?IGp-jqG;7jdY^1J%G2L9!5l;vTxw zadFN_o0?H^#M8wK+E$M;^;4t!b)ZkV$p+?TcuMdQnIJ7 zhNUN19gj;XMcQUFg&iUuM|$AehO8v(OVRmQtL4s+`I*KTlHU7gygvS}#l= z!y?-43(0DRc^@OKAMTge9hG+is&g)?@`%Us7uP9pB83$Zvt|o=1(>)Yl&j3h>%_!2 zIu0om$(s;s;9kfrf(}drYSBHJSLXY#^^L8v%o-Su$~PgP=?UmmpjNP*((glH?N*p8 z&KXgj8g1j1)N%4drM+pIg)=l_6ie&_PJ`Vwm8b<^dAogfe%fyPn*^7?pI^MXY+Ztg zv072I_61s;qG)G=ZGLP7=8A7+FEK+2+{Z4|fmmE}l{HegTMkj~sIi4^s*B}eT)Wh7 z28I$E**uWMg+Caq;&LrpwM&yx35{3#Njwy;ABq;ZBq6u(lUe zLtuB`jKBbs@J|kvU#jF<{#{uZdTNGYoLS&}1jqq)iG~t@Zg$Z(06VTlt@Y%2*oTZr zUL*nhd<98avjN#t(g#lcs4ENZP4 zCJT`}a0d%Y0~N+}0i&;J<(k!6ym(Tm({E`QH3{l-XtT^RY6>I$fsub;eF~q}8xk0m zX|OPnjUdMbiL>eue0IP-T2Eq=N(E9U4hDugtZ7qbF>K`-6WC2!cD7o7N$U{+9J zRb=`mqY5OMTG(@?KHy+F)@}`|Tj4TFVvkVZk*OgF+bPEewk8#D{GhQ)5hj|(W3`y> z+wcj2Zk%jIM}w5LQ%~9h)n~1^DTbE{fFCzupvi`)lS8bxXa`{r%OG8JXCYmb3AheT ze6fXEJFB#C>23%5O&Y^N`+;f{8syWzZx zY+ifeK$np2mV63c7Yk!THSq9!ea4c^CLS340Fgt1tuvP~ccvxyeQx>8^nl^Rtz8r> ztVpn)p@T-%fs}B`4yZuHDT^xKka3!pPDWakc{j%mHxFIG7VA^F!GWe=qYj}4`0M;d zvj|=C8o?N24(B^?!&c=|AS&q)5M2}nFNDA%CY6+7^A7%LGrv|si<4P!KqAs4b9$TR z)5`v@I?;uLJr!Bx_;EZDy(}SZ!h(#qAXtV>aeCVYJQc`OImOe0nXuC(E9GhH_}Tfz z^&5BZDkj}*u!eTARLCe#8zb_OJHUq8doY=9n1V>iX0#}UBq%ln8`LZC zFmXC5d)IPr3K<4_g(Da0iUOwH)hTuvATa}$fsV>q7@X#JAPhYL;rA%Y`s_KpH=tV& zoh*z9M@TPAmqA~iT|K`zg$VA5&}avKp)Mpgd|hZZ+X+=%gd!&BaWn-FV3-{vRF|BCNNg1a101S1>H2mA+{2I7?C@3#}(AlkV7h;1$iB$xFJkuwlAksPHDJEI5+Ti zK{t=i%fY@y<=IgNQp}O^FqfjJlP69a0D2vt7hUE=5L%1@qQHzWzo=M20CILE?}GM4 z40Ot3VSAOh2!V;qqeMXok2irr!IbOHC)9EvSreY*<+XfREXb#08_Y@+5eE&Lsq6Djf+n@|M6>T@^4He$~psrpd|~N(zT__1o3O z>(=p$X1RcmQP-qudUBko(THz;R7kupM?aiC{MGZ;`LC_>XR>uJTUTeVk70Ab`K!r@ zn`8~{0*tf)=Okgn#305g1mzASM7b}#G0_b`d*Poj@fIE6$pBFj<8%su!o*!f0EM7Z zb4W--VK(SGa+88qj+YzshsYyX4jL%cpa>p8HeMY?Dz|-LI@YDh2m`I?-WbRFAV$sk zTRC9jj&<6muDsI=vFJ$+fAWb6Z{RVnV{s!2sA)d&vPU2Jo7VBtI z7SJtn7;Ajp#tT&tyBoA8KpSem>Y%SQBzZ%EN715LxykJD;}mwV#97h|)SFVYHUPzF z@cm@uFSy)6*4G>|r~*_H@Npp(PrRBTMp+ER5lJW+Ws&7n2xL(bf~p2iP8g95C%EQp zIrb@a1yK#3whyb^2Pi?Ws{+11ok!f9R62KzV1W!oRcTNKhp)19&1gbQV}FHnPo6w& zH+}pc^ANQCz6xVEfQe~VohG&{hl(3IMFP%sLWt@pX(v{KIfBmuphS6ET{1PQ7aZY$ zHgD0!>1{u~R$OpK0|V{UK|7z6=#i_&@j}JWG*Phy8yyy-hpHG{St*}|VgNIqo{A7n zcFZF%i~-?~lQ2y+aVMkvw@A?n)AgBtLpWh}bQg2hVFqeXK13%alXaAaq)@ecc;c9{ zJk61?%#!8eaLaS}5tbOTd=EpG=P{&4j?e)wCOFwpm+b%K$wK0bWEXN0(IAB6hdNf?$82j!*bgylCLU5$6p{-oIWQYi>l`z9;!)G@)SxmM zC~Cq5Ck;7nqlmQ0jrl5@`K~)(o(1iRVO_VjdX#~si?s?@6aw>?}AicuSoUu!X z#8T20M5qRa+Vpi2&R_|+2#E92a!Oz<7?}LZ7)2S12zlKMyd{?SOfnnl;-_N58^nH>kqXvZ`ORx*k zx|Y6Amz?#3o5~{mLQIK-+H!8o7wA>-j}CrCY2oq&7t8I{=56cctBcoH$LCk=lZzL> zy*$6Wo9^O=L8px^IM}2EIn#>O*lUo}6Zu#@V^-=9qSPr9M6104A4H|>O;5&En`IImdhN>R|RqeXN*n5eGczHlyxb>&N z*lETT1J@$#D(YYyb6G-ayOu817|0~B z0#4P_K&L8<^1{-Vd}9*wTyOaMS3>w+igR=2E6P^m)m@0E;U9{qILQKj1E>s%t=O5t z)VNRIR?Z`p8hYTd5oRUD5t??Bep;M6Pswn0%q z&WjpCywI3GaUGl;L7~sw9>anPJJ}acPT}9e+V_;Do&qPuRY9!WCE^@qlNLAJEE%8X}M}XJSqY z7USCr)>^Es|8IL&*4)N%g!4SVVuNy(h!_OTP;x9DD1(P6*rG&%WMbyUwFDO6CJQWT z7Z8jb|2_S6&$S0g##K2UwqGQY!0a47eSY05LLww)(W&lUR}BgxV-n8Dc?dI!v1oS} zh6ZmoZC)5>#J}Qs93pZE^QEI~C|s9)!}vb7WndDt?{T;+un27X9QtT?OvXU-7Mn2D2CeaONlYx%PKO+}q=3!0dLWk7S z^;~g0mbe%KP-8OfEh{X;Kifr!Z%+a;4@MDlxybD(BPMpGd}EjyhWAP2ODNISdDZ5A zYRq=Iq%Pz?UhejYw~XxP@$fskqdUyHC%s_5U8$KajH3}@Z7%vdjYc7^DLkzuyUu#$ z;6ki@Y)pc5MH8N-D7L}jbZi@irJ|>2fQ{l9weHr=5BxLn)O6HC^9}9#=}P#`a98T#74Csz^7sMKn~vSh(r^KM3Ga5 zt5_&USx;*JV<<0W%ZRXe&hy`vE?{Binq5uUne9XC>+sbTV5f4sJPXGbkg;I{QW^rJ zdND5BE5V*zA0 z`9>o+9_}Wj@XxN+Nwe+KtZ&$H3+wxEoFk^)UM+pNO9>QIkxTqch%QBJ6C?3u;)Hx|XUBy-_CN^a5>9Yt8G;{} z%ecx54;Ut424+Xq*lAD=syuXutYjohN@l_=+&qX+F{jD1e;~Fyt!J)UY!tM-t4#hW zJeP44O87*KZxfB?MHQ?U<2YG-$vR4sPOzHOPR{8%v^}3ntRQntI>)Smz>(!-FM$MQ zsDUH~aH2T$;L@L-V-f`N0E7)8|B;D|#=B!6EKSR%bfP{S$7EVgqkj}xVo!eCb6!XB z?*=kR#uf4^5?B(0TJ~I9mALcB^U*)vFOoHQ+nxcN8v9*+59P_^&dy>64ZDlD^A!(G zjxCMX)?w=H_b}M0yN8uLUNMq@S`t}6k00Zql3js0{{HpXrF(Z<$T}_=+HCUbB1Hi= z;!+&r>VYviVkGPheXn3Wi36!iGl?^&5@Kp=SOeB((iSce5^3}f0(Q#AMJ;E5dm`|l z6U3fh%Lz4Z@&!1t4-|?8|G=!M1&FYyb?%FBAp;NR)aVSCFhT86Xk76M7)K{;QDh{5 zE)L70breUHl&jU1|Q57ytgK z^xc}$;qsSFv9S5>Hm>#aT5;|U5NsmG`4O*)<*=ADG>sm6X=leH^mOU9HKvC)S&hgU z&ZEK(+Y>4E2kYp(>yg1hl6;5VDR=}M9%7D|0VBv^M=17Ub2o&4R&l~8D61F_%Nzfa z!fbcLUUo!Y^;h|1Q$9FxN8MknQ)qwq1Et&Bl;GhK)PwLA32g_5=PY8xCHQUrZYOc?rY=uLDPli;lph zTa@W0MjB<{6elMmIM^&`Mvs$;Q@YAP<1o4&S)L3@MT$#IPB1tB^!MPaNt)J|3UF1s zOKd(y+U?V$7UKyhZ}TQ%J3qDCq_dcP%*@zMz&Ly*wVWK8QE9cNXp}QTg%2rSbIs!l z1(%g4Gj7(~*qH#Nzew*PfnSoLV*+YGiNt^>(8nZrGFc^Rl4=-?;}j0}(@f2T>gy6K z)qHk-1=HLOdx9T!d#+Z`+UR~(NXtnMQKc+RB_-I_SqS!r$zmL>*m?y(6y-(cDQaip zqdz!J_e$I{$q+j9yEdN7(zh+iB@Nyqi-N^9n{(Vl>WNLM+XLMu0oaLfr`UJy#>At3 zzT>laWePeyW5|kWolk*xTlo-=uV-pE^`C6>l+aSYbJa-!A6u@Jv?nV=>`J1!=a5v< zxS+f&Y)lY5fw=*&4+@sSO$;oe!9RxyJNBa}g9of}Q)4SPybNmr#(_iR)}gWE)1Y9q z`G~c?Si2e53oIo)ZP?L+&Ofe5#q0u~&;E<4M`Z?4Yh$PxFx5KDyKX;S8JSJwZrf51 zwdilAL*S)FypIlw2406E9}S;HDrChV`|Z_C`BtUPof4#HkJXW>HK@D<0&W-X%dM4wPQRWxsRZ>aX8pQY-(Ep4W!Q@xsd&;en&xy;(GxlUB+O$5c zg-iq4XW0i^ZCIn!{WTXqN-?C8SfZ>g}=!M1J#ES#xh(FCZ@P{l-Vs)@!5p>y{8pYXYH6w2h1z#rSDgAWI znCaog=exo1;_BifT)Lq_X7Z7uMXuo;*7raDNE~t{_(3!}hUoGN{CSPn;VKC}Aa)n*nCRT_dO$uj7mTHA1jCfx zW@$L-x&q|3MG$%*XVSCE#CRPu_3v)qe;NjR!P%$l`{Cg7{jE|L=xYB%HyEaj+2t23 zd_P)*^DglWDrOg(jM42oqjq516!>4#$e|%Vl?TI!^zs*o@lsv+B#V%Sm@L<1R36!I z9VxXq*BvMs|2rS=r5@Z)A!?pE)C&@J>_amKPJ*lur>2WDxlQ?km_@*)9aPhWY|W37 z6=~!azSimlEty!0wJu9<`GtfYSYzr7pkmp1%SPUALz?%j7+pUvB$#3Fvv(EsrLFC@1Q z{$Jkz%kTd?;P?MD?|=Glp8tRD1%SWe{eK5tILk%_5P(uwh k)KEhWHPlc;4K>tILk%_5P(uwh)X=l^FRKSgTL7Q{03-NA#sB~S literal 0 HcmV?d00001 diff --git a/Iterator.pm b/Iterator.pm new file mode 100644 index 0000000..73e76b8 --- /dev/null +++ b/Iterator.pm @@ -0,0 +1,832 @@ +=for gpg +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA1 + +=head1 NAME + +Iterator - A general-purpose iterator class. + +=head1 VERSION + +This documentation describes version 0.03 of Iterator.pm, October 10, 2005. + +=cut + +use strict; +use warnings; +package Iterator; +our $VERSION = '0.03'; + +# Declare exception classes +use Exception::Class + ( + 'Iterator::X' => + { + description => 'Generic Iterator exception', + }, + 'Iterator::X::Parameter_Error' => + { + isa => 'Iterator::X', + description => 'Iterator method parameter error', + }, + 'Iterator::X::OptionError' => + { + isa => 'Iterator::X', + fields => 'name', + description => 'A bad option was passed to an iterator method or function', + }, + 'Iterator::X::Exhausted' => + { + isa => 'Iterator::X', + description => 'Attempt to next_value () on an exhausted iterator', + }, + 'Iterator::X::Am_Now_Exhausted' => + { + isa => 'Iterator::X', + description => 'Signals Iterator object that it is now exhausted', + }, + 'Iterator::X::User_Code_Error' => + { + isa => 'Iterator::X', + fields => 'eval_error', + description => q{An exception was thrown within the user's code}, + }, + 'Iterator::X::IO_Error' => + { + isa => 'Iterator::X', + fields => 'os_error', + description => q{An I/O error occurred}, + }, + 'Iterator::X::Internal_Error' => + { + isa => 'Iterator::X', + description => 'An Iterator.pm internal error. Please contact author.', + }, + ); + +# Class method to help caller catch exceptions +BEGIN +{ + # Dave Rolsky added this subroutine in v1.22 of Exception::Class. + # Thanks, Dave! + # We define it here so we have the functionality in pre-1.22 versions; + # we make it conditional so as to avoid a warning in post-1.22 versions. + *Exception::Class::Base::caught = sub + { + my $class = shift; + return Exception::Class->caught($class); + } + if $Exception::Class::VERSION lt '1.22'; +} + +# Croak-like location of error +sub Iterator::X::location +{ + my ($pkg,$file,$line); + my $caller_level = 0; + while (1) + { + ($pkg,$file,$line) = caller($caller_level++); + last if $pkg !~ /\A Iterator/x && $pkg !~ /\A Exception::Class/x + } + return "at $file line $line"; +} + +# Die-like location of error +sub Iterator::X::Internal_Error::location +{ + my $self = shift; + return "at " . $self->file () . " line " . $self->line () +} + +# Override full_message, to report location of error in caller's code. +sub Iterator::X::full_message +{ + my $self = shift; + + my $msg = $self->message; + return $msg if substr($msg,-1,1) eq "\n"; + + $msg =~ s/[ \t]+\z//; # remove any trailing spaces (is this necessary?) + return $msg . q{ } . $self->location () . qq{\n}; +} + + +## Constructor + +# Method name: new +# Synopsis: $iterator = Iterator->new( $code_ref ); +# Description: Object constructor. +# Created: 07/27/2005 by EJR +# Parameters: $code_ref - the iterator sequence generation code. +# Returns: New Iterator. +# Exceptions: Iterator::X::Parameter_Error (via _initialize) +sub new +{ + my $class = shift; + my $self = \do {my $anonymous}; + bless $self, $class; + $self->_initialize(@_); + return $self; +} + +{ # encapsulation enclosure + + # Attributes: + my %code_for; # The sequence code (coderef) for each object. + my %is_exhausted; # Boolean: is this object exhausted? + my %next_value_for; # One-item lookahead buffer for each object. + # [if you update this list of attributes, be sure to edit DESTROY] + + # Method name: _initialize + # Synopsis: $iterator->_initialize( $code_ref ); + # Description: Object initializer. + # Created: 07/27/2005 by EJR + # Parameters: $code_ref - the iterator sequence generation code. + # Returns: Nothing. + # Exceptions: Iterator::X::Parameter_Error + # Iterator::X::User_Code_Error + # Notes: For internal module use only. + # Caches the first value of the iterator in %next_value_for. + sub _initialize + { + my $self = shift; + + Iterator::X::Parameter_Error->throw(q{Too few parameters to Iterator->new()}) + if @_ < 1; + Iterator::X::Parameter_Error->throw(q{Too many parameters to Iterator->new()}) + if @_ > 1; + my $code = shift; + Iterator::X::Parameter_Error->throw (q{Parameter to Iterator->new() must be code reference}) + if ref $code ne 'CODE'; + + $code_for {$self} = $code; + + # Get the next (first) value for this iterator + eval + { + $next_value_for{$self} = $code-> (); + }; + + my $ex; + if ($ex = Iterator::X::Am_Now_Exhausted->caught ()) + { + # Starting off exhausted is okay + $is_exhausted{$self} = 1; + } + elsif ($@) + { + Iterator::X::User_Code_Error->throw (message => "$@", + eval_error => $@); + } + + return; + } + + # Method name: DESTROY + # Synopsis: (none) + # Description: Object destructor. + # Created: 07/27/2005 by EJR + # Parameters: None. + # Returns: Nothing. + # Exceptions: None. + # Notes: Invoked automatically by perl. + # Releases the hash entries used by the object. + # Module would leak memory otherwise. + sub DESTROY + { + my $self = shift; + delete $code_for{$self}; + delete $is_exhausted{$self}; + delete $next_value_for{$self}; + } + + # Method name: value + # Synopsis: $next_value = $iterator->value(); + # Description: Returns each value of the sequence in turn. + # Created: 07/27/2005 by EJR + # Parameters: None. + # Returns: Next value, as generated by caller's code ref. + # Exceptions: Iterator::X::Exhausted + # Notes: Keeps one forward-looking value for the iterator in + # %next_value_for. This is so we have something to + # return when user's code throws Am_Now_Exhausted. + sub value + { + my $self = shift; + + Iterator::X::Exhausted->throw(q{Iterator is exhausted}) + if $is_exhausted{$self}; + + # The value that we'll be returning this time. + my $this_value = $next_value_for{$self}; + + # Compute the value that we'll return next time + eval + { + $next_value_for{$self} = $code_for{$self}->(@_); + }; + if (my $ex = Iterator::X::Am_Now_Exhausted->caught ()) + { + # Aha, we're done; we'll have to stop next time. + $is_exhausted{$self} = 1; + } + elsif ($@) + { + Iterator::X::User_Code_Error->throw (message => "$@", + eval_error => $@); + } + + return $this_value; + } + + # Method name: is_exhausted + # Synopsis: $boolean = $iterator->is_exhausted(); + # Description: Flag indicating that the iterator is exhausted. + # Created: 07/27/2005 by EJR + # Parameters: None. + # Returns: Current value of %is_exhausted for this object. + # Exceptions: None. + sub is_exhausted + { + my $self = shift; + + return $is_exhausted{$self}; + } + + # Method name: isnt_exhausted + # Synopsis: $boolean = $iterator->isnt_exhausted(); + # Description: Flag indicating that the iterator is NOT exhausted. + # Created: 07/27/2005 by EJR + # Parameters: None. + # Returns: Logical NOT of %is_exhausted for this object. + # Exceptions: None. + sub isnt_exhausted + { + my $self = shift; + + return ! $is_exhausted{$self}; + } + +} # end of encapsulation enclosure + + +# Function name: is_done +# Synopsis: Iterator::is_done (); +# Description: Convenience function. Throws an Am_Now_Exhausted exception. +# Created: 08/02/2005 by EJR, per Will Coleda's suggestion. +# Parameters: None. +# Returns: Doesn't return. +# Exceptions: Iterator::X::Am_Now_Exhausted +sub is_done +{ + Iterator::X::Am_Now_Exhausted->throw() +} + + +1; +__END__ + +=head1 SYNOPSIS + + use Iterator; + + # Making your own iterators from scratch: + $iterator = Iterator->new ( sub { code } ); + + # Accessing an iterator's values in turn: + $next_value = $iterator->value(); + + # Is the iterator out of values? + $boolean = $iterator->is_exhausted(); + $boolean = $iterator->isnt_exhausted(); + + # Within {code}, above: + Iterator::is_done(); # to signal end of sequence. + + +=head1 DESCRIPTION + +This module is meant to be the definitive implementation of iterators, +as popularized by Mark Jason Dominus's lectures and recent book +(I, Morgan Kauffman, 2005). + +An "iterator" is an object, represented as a code block that generates +the "next value" of a sequence, and generally implemented as a +closure. When you need a value to operate on, you pull it from the +iterator. If it depends on other iterators, it pulls values from them +when it needs to. Iterators can be chained together (see +L for functions that help you do just that), queueing +up work to be done but I until a value is +needed at the front end of the chain. At that time, one data value is +pulled through the chain. + +Contrast this with ordinary array processing, where you load or +compute all of the input values at once, then loop over them in +memory. It's analogous to the difference between looping over a file +one line at a time, and reading the entire file into an array of lines +before operating on it. + +Iterator.pm provides a class that simplifies creation and use of these +iterator objects. Other C modules (see L) +provide many general-purpose and special-purpose iterator functions. + +Some iterators are infinite (that is, they generate infinite +sequences), and some are finite. When the end of a finite sequence is +reached, the iterator code block should throw an exception of the type +C; this is usually done via the +L function.. This will signal the Iterator class to mark +the object as exhausted. The L method will then return +true, and the L method will return false. Any +further calls to the L method will throw an exception of the +type C. See L. + +Note that in many, many cases, you will not need to explicitly create +an iterator; there are plenty of iterator generation and manipulation +functions in the other associated modules. You can just plug them +together like building blocks. + +=head1 METHODS + +=over 4 + +=item new + + $iter = Iterator->new( sub { code } ); + +Creates a new iterator object. The code block that you provide will +be invoked by the L method. The code block should have some +way of maintaining state, so that it knows how to return the next +value of the sequence each time it is called. + +If the code is called after it has generated the last value in its +sequence, it should throw an exception: + + Iterator::X::Am_Now_Exhausted->throw (); + +This very commonly needs to be done, so there is a convenience +function for it: + + Iterator::is_done (); + +=item value + + $next_value = $iter->value (); + +Returns the next value in the iterator's sequence. If C is +called on an exhausted iterator, an C +exception is thrown. + +Note that these iterators can only return scalar values. If you need +your iterator to return a list or hash, it will have to return an +arrayref or hashref. + +=item is_exhausted + + $bool = $iter->is_exhausted (); + +Returns true if the iterator is exhausted. In this state, any call +to the iterator's L method will throw an exception. + +=item isnt_exhausted + + $bool = $iter->isnt_exhausted (); + +Returns true if the iterator is not yet exhausted. + +=back + +=head1 FUNCTION + +=over 4 + +=item is_done + + Iterator::is_done(); + +You call this function after your iterator code has generated its last +value. See L. This is simply a convenience wrapper for + + Iterator::X::Am_Now_Exhausted->throw(); + +=back + +=head1 THINKING IN ITERATORS + +Typically, when people approach a problem that involves manipulating a +bunch of data, their first thought is to load it all into memory, into +an array, and work with it in-place. If you're only dealing with one +element at a time, this approach usually wastes memory needlessly. + +For example, one might get a list of files to operate on, and loop +over it: + + my @files = fetch_file_list(....); + foreach my $file (@files) + ... +If C were modified to return an iterator instead of +an array, the same code could look like this: + + my $file_iterator = fetch_file_list(...) + while ($file_iterator->isnt_exhausted) + ... + +The advantage here is that the whole list does not take up memory +while each individual element is being worked on. For a list of +files, that's probably not a lot of overhead. For the contents of +a file, on the other hand, it could be huge. + +If a function requires a list of items as its input, the overhead +is tripled: + + sub myfunc + { + my @things = @_; + ... + +Now in addition to the array in the calling code, Perl must copy that +array to C<@_>, and then copy it again to C<@things>. If you need to +massage the input from somewhere, it gets even worse: + + my @data = get_things_from_somewhere(); + my @filtered_data = grep {code} @data; + my @transformed_data = map {code} @filtered_data; + myfunc (@transformed_data); + +If C is rewritten to use an Iterator instead of an array, +things become much simpler: + + my $data = ilist (get_things_from_somewhere()); + $filtered_data = igrep {code} $data; + $transformed_data = imap {code} $filtered_data; + myfunc ($transformed_data); + +(This example assumes that the C function +cannot be modified to return an Iterator. If it can, so much the +better!) Now the original list is still in memory, inside the +C<$data> Iterator, but everwhere else, there is only one data element +in memory at a time. + +Another advantage of Iterators is that they're homogeneous. This is +useful for uncoupling library code from application code. Suppose you +have a library function that grabs data from a filehandle: + + sub my_lib_func + { + my $fh = shift; + ... + +If you need C to get its data from a different source, +you must either modify it, or make a new copy of it that gets its +input differently, or you must jump through hoops to make the new +input stream look like a Perl filehandle. + +On the other hand, if C accepts an iterator, then you +can pass it data from a filehandle: + + my $data = ifile "my_input.txt"; + $result = my_lib_func($data); + +Or a database handle: + + my $data = imap {$_->{IMPORTANT_COLUMN}} + idb_rows($dbh, 'select IMPORTANT_COLUMN from foo'); + $result = my_lib_func($data); + +If you later decide you need to transform the data, or process only +every 10th data row, or whatever: + + $result = my_lib_func(imap {magic($_)} $data); + $result = my_lib_func(inth 10, $data); + +The library function doesn't care. All it needs is an iterator. + +Chapter 4 of Dominus's book (See L) covers this topic in +some detail. + +=head2 Word of Warning + +When you use an iterator in separate parts of your program, or as an +argument to the various iterator functions, you do I get a copy +of the iterator's stream of values. + +In other words, if you grab a value from an iterator, then some other +part of the program grabs a value from the same iterator, you will be +getting different values. + +This can be confusing if you're not expecting it. For example: + + my $it_one = Iterator->new ({something}); + my $it_two = some_iterator_transformation $it_one; + my $value = $it_two->value(); + my $whoops = $it_one->value; + +Here, C takes an iterator as an +argument, and returns an iterator as a result. When a value is +fetched from C<$it_two>, it internally grabs a value from C<$it_one> +(and presumably transforms it somehow). If you then grab a value from +C<$it_one>, you'll get its I value (or third, or whatever, +depending on how many values C<$it_two> grabbed), not the first. + +=head1 TUTORIAL + +Let's create a date iterator. It'll take a L object as a +starting date, and return successive days -- that is, it'll add 1 day +each iteration. It would be used as follows: + + use DateTime; + + $iter = (...something...); + $day1 = $iter->value; # Initial date + $day2 = $iter->value; # One day later + $day3 = $iter->value; # Two days later + +The easiest way to create such an iterator is by using a I. +If you're not familiar with the concept, it's fairly simple: In Perl, +the code within an I has access to all the I that were in scope at the time the block was created. +After the program then leaves that lexical scope, those lexical +variables remain accessible by that code block for as long as it +exists. + +This makes it very easy to create iterators that maintain their own +state. Here we'll create a lexical scope by using a pair of braces: + + my $iter; + { + my $dt = DateTime->now(); + $iter = Iterator->new( sub + { + my $return_value = $dt->clone; + $dt->add(days => 1); + return $return_value; + }); +} + +Because C<$dt> is lexically scoped to the outermost block, it is not +addressable from any code elsewhere in the program. But the anonymous +block within the L method's parentheses I see C<$dt>. So +C<$dt> does not get garbage-collected as long as C<$iter> contains a +reference to it. + +The code within the anonymous block is simple. A copy of the current +C<$dt> is made, one day is added to C<$dt>, and the copy is returned. + +You'll probably want to encapsulate the above block in a subroutine, +so that you could call it from anywhere in your program: + + sub date_iterator + { + my $dt = DateTime->now(); + return Iterator->new( sub + { + my $return_value = $dt->clone; + $dt->add(days => 1); + return $return_value; + }); + } + +If you look at the source code in L, you'll see that +just about all of the functions that create iterators look very +similar to the above C function. + +Of course, you'd probably want to be able to pass arguments to +C, say a starting date, maybe an increment other than +"1 day". But the basic idea is the same. + +The above date iterator is an infinite (well, unbounded) iterator. +Let's look at how to indicate that your iterator has reached the end +of its sequence of values. Let's write a scaled-down version of +L from the Iterator::Util module -- one +that takes a start value and an end value and always increments by 1. + + sub irange_limited + { + my ($start, $end) = @_; + + return Iterator->new (sub + { + Iterator::is_done + if $start > $end; + + return $start++; + }); + } + +The iterator itself is very simple (this sort of thing gets to be easy +once you get the hang of it). The new element here is the signalling +that the sequence has ended, and the iterator's work is done. +L is how your code indicates this to the Iterator object. + +You may also want to throw an exception if the user specified bad input +parameters. There are a couple ways you can do this. + + ... + die "Too few parameters to irange_limited" if @_ < 2; + die "Too many parameters to irange_limited" if @_ > 2; + my ($start, $end) = @_; + ... + +This is the simplest way; you just use C (or C). You may +choose to throw an Iterator parameter error, though; this will make +your function work more like one of Iterator.pm's built in functions: + + ... + Iterator::X::Parameter_Error->throw( + "Too few parameters to irange_limited") + if @_ < 2; + Iterator::X::Parameter_Error->throw( + "Too many parameters to irange_limited") + if @_ > 2; + my ($start, $end) = @_; + ... + + +=head1 EXPORTS + +No symbols are exported to the caller's namespace. + +=head1 DIAGNOSTICS + +Iterator uses L objects for throwing exceptions. +If you're not familiar with Exception::Class, don't worry; these +exception objects work just like C<$@> does with C and C, +but they are easier to work with if you are trapping errors. + +All exceptions thrown by Iterator have a base class of Iterator::X. +You can trap errors with an eval block: + + eval { $foo = $iterator->value(); }; + +and then check for errors as follows: + + if (Iterator::X->caught()) {... + +You can look for more specific errors by looking at a more specific +class: + + if (Iterator::X::Exhausted->caught()) {... + +Some exceptions may provide further information, which may be useful +for your exception handling: + + if (my $ex = Iterator::X::User_Code_Error->caught()) + { + my $exception = $ex->eval_error(); + ... + +If you choose not to (or cannot) handle a particular type of exception +(for example, there's not much to be done about a parameter error), +you should rethrow the error: + + if (my $ex = Iterator::X->caught()) + { + if ($ex->isa('Iterator::X::Something_Useful')) + { + ... + } + else + { + $ex->rethrow(); + } + } + +=over 4 + +=item * Parameter Errors + +Class: C + +You called an Iterator method with one or more bad parameters. Since +this is almost certainly a coding error, there is probably not much +use in handling this sort of exception. + +As a string, this exception provides a human-readable message about +what the problem was. + +=item * Exhausted Iterators + +Class: C + +You called L on an iterator that is exhausted; that is, there +are no more values in the sequence to return. + +As a string, this exception is "Iterator is exhausted." + +=item * End of Sequence + +Class: C + +This exception is not thrown directly by any Iterator.pm methods, but +is to be thrown by iterator sequence generation code; that is, the +code that you pass to the L constructor. Your code won't catch +an C exception, because the Iterator object will +catch it internally and set its L flag. + +The simplest way to throw this exception is to use the L +function: + + Iterator::is_done() if $something; + +=item * User Code Exceptions + +Class: C + +This exception is thrown when the sequence generation code throws any +sort of error besides C. This could be because your +code explicitly threw an error (that is, Cd), or because it +otherwise encountered an exception (any runtime error). + +This exception has one method, C, which returns the +original C<$@> that was trapped by the Iterator object. This may be a +string or an object, depending on how C was invoked. + +As a string, this exception evaluates to the stringified C<$@>. + +=item * I/O Errors + +Class: C + +This exception is thrown when any sort of I/O error occurs; this +only happens with the filesystem iterators. + +This exception has one method, C, which returns the original +C<$!> that was trapped by the Iterator object. + +As a string, this exception provides some human-readable information +along with C<$!>. + +=item * Internal Errors + +Class: C + +Something happened that I thought couldn't possibly happen. I would +appreciate it if you could send me an email message detailing the +circumstances of the error. + +=back + +=head1 REQUIREMENTS + +Requires the following additional module: + +L, v1.21 or later. + +=head1 SEE ALSO + +=over 4 + +=item * + +I, Mark Jason Dominus, Morgan Kauffman 2005. + +L + +=item * + +The L module, for general-purpose iterator functions. + +=item * + +The L module, for filesystem and stream iterators. + +=item * + +The L module, for iterating over a DBI record set. + +=item * + +The L module, for various oddball iterator functions. + +=back + +=head1 THANKS + +Much thanks to Will Coleda and Paul Lalli (and the RPI lily crowd in +general) for suggestions for the pre-release version. + +=head1 AUTHOR / COPYRIGHT + +Eric J. Roode, roode@cpan.org + +Copyright (c) 2005 by Eric J. Roode. All Rights Reserved. +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +To avoid my spam filter, please include "Perl", "module", or this +module's name in the message's subject line, and/or GPG-sign your +message. + +=cut + +=begin gpg + +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.1 (Cygwin) + +iD8DBQFDSrnpY96i4h5M0egRAg65AJ9nP1ybUFl7GgpW9sZKOAEm3UF8MQCgul3g +zElCa4hIQkHXtcAwYwiEPCY= +=B5j0 +-----END PGP SIGNATURE----- + +=end gpg diff --git a/Iterator.ppd b/Iterator.ppd new file mode 100644 index 0000000..c952f44 --- /dev/null +++ b/Iterator.ppd @@ -0,0 +1,12 @@ + + Iterator + A general-purpose iterator class. + Eric Roode <roode@cpan.org> + + + + + + + + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..1574c46 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,11 @@ +Changes +Makefile.PL +MANIFEST +README +Iterator.pm +Iterator.ppd +Iterator-ppm.tar.gz +t/doc.t +t/new.t +t/value.t +META.yml Module meta-data (added by MakeMaker) diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..8f7aa8a --- /dev/null +++ b/META.yml @@ -0,0 +1,12 @@ +# http://module-build.sourceforge.net/META-spec.html +#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# +name: Iterator +version: 0.03 +version_from: Iterator.pm +installdirs: site +requires: + Exception::Class: 1.21 + Test::Simple: 0.40 + +distribution_type: module +generated_by: ExtUtils::MakeMaker version 6.17 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..3125a45 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,63 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'Iterator', + 'VERSION_FROM' => 'Iterator.pm', # finds $VERSION + 'PREREQ_PM' => {'Test::Simple' => '0.40', + 'Exception::Class' => 1.21, + }, + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'Iterator.pm', # retrieve abstract from module + AUTHOR => 'Eric Roode ') : ()), +); + + +package MY; + +sub dist_core +{ + my $text = shift->SUPER::dist_core(@_); + $text =~ s/^(\$\(DISTVNAME\)[^:]*): (.*)/$1: ppd ppm $2/mg; + return $text; +} + +sub realclean +{ + my $text = shift->SUPER::realclean(@_); + $text .= <<'CLEAN'; + rm -rf $(PPDFILE) $(PPMFILE) +CLEAN + return $text; +} + +sub ppd +{ + my $self = shift; + my $text = $self->SUPER::ppd(@_); + $text =~ s/(ppd\s*:)/$1 \$(PPDFILE)\n\n\$(PPDFILE) :/; + $text =~ s[(?<={DISTNAME}-$self->{VERSION}/$self->{DISTNAME}-ppm.tar.gz]; + + # This release is allegedly OS and architecture independent (as it's pure perl) + $text =~ s/]+>(?:\\[nt])*//; + $text =~ s/]+>(?:\\[nt])*//; + + $text = <<'PRE' . $text; + +PPMNAME = $(DISTNAME)-ppm +PPDFILE = $(DISTNAME).ppd +PPMFILE = $(PPMNAME).tar.gz + +PRE + + $text .= <<'PPM'; + + +ppm: $(PPMFILE) + +$(PPMFILE): pm_to_blib $(INST_LIBDIR)/.exists $(INST_ARCHAUTODIR)/.exists $(INST_AUTODIR)/.exists + $(TAR) $(TARFLAGS) - blib | $(COMPRESS) -c > $(PPMFILE) +PPM + return $text; +} diff --git a/README b/README new file mode 100644 index 0000000..15b3b3d --- /dev/null +++ b/README @@ -0,0 +1,83 @@ +Iterator version 0.03 +===================== + +This module is meant to be the definitive implementation of iterators, +as popularized by Mark Jason Dominus's lectures and recent book +(_Higher Order Perl_, Morgan Kauffman, 2005). + +An "iterator" is an object, represented as a code block that generates +the "next value" of a sequence, and generally implemented as a +closure. Iterator.pm provides a class that simplifies creation and +use of these iterator objects. + +EXAMPLES + +Synopsis: + + $it = Iterator->new( sub { some code } ); + +Simple "upto" counter (Dominus, p. 121): + + sub upto + { + my ($m, $n) = @_; + + return Iterator->new( sub { + return $m++ if $m <= $n; + Iterator::X::Am_Now_Exhausted->throw(); + }); + } + + my $it = upto (3, 5); + + $i = $it->value; # returns 3 + $i = $it->value; # returns 4 + $i = $it->value; # returns 5 + $i = $it->value; # throws an Iterator::X::Exhausted exception. + + $another_it = upto (7, 10); + while ($another_it->isnt_exhausted) + { + print $another_it->value, "\n"; + } + # The above prints 7, 8, 9, 10 and throws no exceptions. + # Another call to $another_it->value would throw an exception. + +DEVELOPMENT STATE + +This is a brand-new module. It has a decent test suite, but has +not been extensively field-tested. Therefore, it should be considered +"beta" software, and used with care. + +If you find any bugs, or if any behavior of Iterator surprises you, +I would be grateful if you could send me an email message about it. +Thanks. + + +INSTALLATION + +To install this module, do the standard Perl module four-step: + + perl Makefile.PL or perl Makefile.pl LIB='my/install/path' + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + + Exception::Class + Test::Simple + +COPYRIGHT AND LICENSE + +Eric J. Roode, roode@cpan.org + +To avoid my spam filter, please include "Perl", "module", or this +module's name in the message's subject line, and/or GPG-sign your +message. + +Copyright (c) 2005 by Eric J. Roode. All Rights Reserved. +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. diff --git a/t/doc.t b/t/doc.t new file mode 100644 index 0000000..bd19972 --- /dev/null +++ b/t/doc.t @@ -0,0 +1,85 @@ +use strict; +use Test::More tests => 13; +use Iterator; + +# Check that the documentation examples work. + +sub begins_with +{ + my ($actual, $expected, $test_name) = @_; + + $actual = substr($actual, 0, length $expected); + @_ = ($actual, $expected, $test_name); + goto &is; +} + +my ($iter, $it, $x, @vals); + +# from the README (13) + +sub upto +{ + my ($m, $n) = @_; + + return Iterator->new( sub { + return $m++ if $m <= $n; + Iterator::X::Am_Now_Exhausted->throw(); + }); +} + +@vals = (); +eval +{ + $it = upto (3, 5); +}; + +is ($@, q{}, q{README iterator created, no exception}); + +eval +{ + push @vals, $it->value; # returns 3 + push @vals, $it->value; # returns 4 + push @vals, $it->value; # returns 5 +}; + +is ($@, q{}, q{README iterator; first three okay}); +is_deeply (\@vals, [3, 4, 5], q{README iterator: expected values ok}); + +eval +{ + my $i = $it->value; # throws an Iterator::X::Exhausted exception. +}; + +isnt ($@, q{}, q{README iterator: exception thrown}); +ok (Iterator::X->caught(), q{README exception: correct base type}); +ok (Iterator::X::Exhausted->caught(), q{README exception: correct specific type}); +begins_with ($@, q{Iterator is exhausted}, q{README iterator exception formatted propertly.}); + +{ + my $another_it; + + @vals = (); + eval + { + $another_it = upto (7, 10); + while ($another_it->isnt_exhausted) + { + push @vals, $another_it->value; + } + # The above [pushes] 7, 8, 9, 10 and throws no exceptions. + }; + + is ($@, q{}, q{$another_it: no exception thrown}); + is_deeply (\@vals, [7, 8, 9, 10], q{$another_it: expected values}); + + eval + { + # Another call to $another_it->value would throw an exception. + $another_it->value + }; + + isnt ($@, q{}, q{$another_it iterator: exception thrown}); + ok (Iterator::X->caught(), q{$another_it exception: correct base type}); + ok (Iterator::X::Exhausted->caught(), q{$another_it exception: correct specific type}); + begins_with ($@, q{Iterator is exhausted}, q{$another_it iterator exception formatted propertly.}); +} diff --git a/t/new.t b/t/new.t new file mode 100644 index 0000000..986eef4 --- /dev/null +++ b/t/new.t @@ -0,0 +1,109 @@ +use strict; +use Test::More tests => 18; +use Iterator; + +# Check that new() fails when it should. + +sub begins_with +{ + my ($actual, $expected, $test_name) = @_; + + $actual = substr($actual, 0, length $expected); + @_ = ($actual, $expected, $test_name); + goto &is; +} + +my ($iter, $x); + +# New: too few (4) +eval +{ + $iter = Iterator->new(); +}; + +$x = $@; +isnt $x, q{}, q{Too few parameters to new -> exception thrown}; + +ok (Iterator::X->caught(), q{Too-few exception base class ok}); + +ok (Iterator::X::Parameter_Error->caught(), q{Too-few exception specific class ok}); + +begins_with $x, + q{Too few parameters to Iterator->new()}, + q{Too-few exception works as a string, too}; + +# New: too many (4) +eval +{ + $iter = Iterator->new(sub {die}, 'whoa there'); +}; + +$x = $@; +isnt $x, q{}, q{Too many parameters to new -> exception thrown}; + +ok (Iterator::X->caught(), q{Too-many exception base class ok}); + +ok (Iterator::X::Parameter_Error->caught(), q{Too-many exception specific class ok}); + +begins_with $x, + q{Too many parameters to Iterator->new()}, + q{Too-many exception works as a string, too}; + +# New: wrong type (4) +eval +{ + $iter = Iterator->new('whoa there'); +}; + +$x = $@; +isnt $x, q{}, q{Wrong type of parameter to new -> exception thrown}; + +ok (Iterator::X->caught(), q{Wrong-type exception base class ok}); + +ok (Iterator::X::Parameter_Error->caught(), q{Wrong-type exception specific class ok}); + +begins_with $x, + q{Parameter to Iterator->new() must be code reference}, + q{Wrong-type exception works as a string, too}; + +# New: wrong type (looks like code but isn't) (4) +eval +{ + $iter = Iterator->new({qw/whoa there/}); +}; + +$x = $@; +isnt $x, q{}, q{Bad code ref parameter to new -> exception thrown}; + +ok (Iterator::X->caught(), q{Bad-coderef exception base class ok}); + +ok (Iterator::X::Parameter_Error->caught(), q{Bad-coderef exception specific class ok}); + +begins_with $x, + q{Parameter to Iterator->new() must be code reference}, + q{Bad-coderef exception works as a string, too}; + +# New: everything fine (1) +eval +{ + my $i = 0; + $iter = Iterator->new( sub {return $i++}); +}; + +$x = $@; +is $x, q{}, q{Simple invocation: no exception}; + + +# New: everything fine (1) +eval +{ + my $i = 0; + $iter = Iterator->new( sub { + Iterator::X::Am_Now_Exhausted->throw if $i > 10; + return $i++; + }); +}; + +$x = $@; +is $x, q{}, q{more-complicated invocation: no exception}; + diff --git a/t/value.t b/t/value.t new file mode 100644 index 0000000..7920f8f --- /dev/null +++ b/t/value.t @@ -0,0 +1,170 @@ +use strict; +use Test::More tests => 33; +use Iterator; + +# Check that value() works. +# Also tests is_ and isnt_exhausted. + +sub begins_with +{ + my ($actual, $expected, $test_name) = @_; + + $actual = substr($actual, 0, length $expected); + @_ = ($actual, $expected, $test_name); + goto &is; +} + +my ($iter, $x, $val, $exh, $nex); + +# Create iterator for us to work with (1) +eval +{ + my $i = 1; + my $max = 3; + + $iter = Iterator->new ( + sub + { + Iterator::X::Am_Now_Exhausted->throw() + if ($i > $max); + return $i++; + } + ); +}; + +is $@, q{}, q{Created simple iterator; no exception}; + +# That iterator should not be exhausted already. (3) +eval +{ + $exh = $iter->is_exhausted; + $nex = $iter->isnt_exhausted; +}; + +is ($@, q{}, q{Exhausted check didn't barf.}); +ok (!$exh, q{Not exhausted yet.}); +ok ( $nex, q{Not exhausted yet.}); + +# Fetch a value (2) +eval +{ + $val = $iter->value(); +}; + +is $@, q{}, q{Pulled first value from iterator; no exception}; +cmp_ok ($val, '==', 1, q{First value is correct}); + +# That iterator should not be exhausted yet. (3) +eval +{ + $exh = $iter->is_exhausted; + $nex = $iter->isnt_exhausted; +}; + +is ($@, q{}, q{Exhausted check didn't barf.}); +ok (!$exh, q{Not exhausted yet.}); +ok ( $nex, q{Not exhausted yet.}); + + +# Fetch a value (2) +eval +{ + $val = $iter->value(); +}; + +is $@, q{}, q{Pulled second value from iterator; no exception}; +cmp_ok ($val, '==', 2, q{Second value is correct}); + +# That iterator should not be exhausted yet. (3) +eval +{ + $exh = $iter->is_exhausted; + $nex = $iter->isnt_exhausted; +}; + +is ($@, q{}, q{Exhausted check didn't barf.}); +ok (!$exh, q{Not exhausted yet.}); +ok ( $nex, q{Not exhausted yet.}); + + +# Fetch a value (2) +eval +{ + $val = $iter->value(); +}; + +is $@, q{}, q{Pulled third value from iterator; no exception}; +cmp_ok ($val, '==', 3, q{Third value is correct}); + + +# Iterator should now be exhausted. (3) +eval +{ + $exh = $iter->is_exhausted; + $nex = $iter->isnt_exhausted; +}; + +is ($@, q{}, q{Exhausted check didn't barf.}); +ok ( $exh, q{Now exhausted.}); +ok (!$nex, q{Now exhausted.}); + + +# Attempt to fetch a value from it (4) +eval +{ + $val = $iter->value(); +}; + +$x = $@; +isnt $@, q{}, q{Pulled fourth value from iterator; got exception}; + +ok (Iterator::X->caught(), q{Exhausted exception base class ok}); + +ok (Iterator::X::Exhausted->caught(), q{Exhausted exception specific class ok}); + +begins_with $x, + q{Iterator is exhausted}, + q{Exhausted exception works as a string, too}; + + +# Should still be able to check exhausted state. (3) +eval +{ + $exh = $iter->is_exhausted; + $nex = $iter->isnt_exhausted; +}; + +is ($@, q{}, q{Exhausted check didn't barf.}); +ok ( $exh, q{Now exhausted.}); +ok (!$nex, q{Now exhausted.}); + + +# Test user exception. (7) +eval +{ + my $internal = 1; + $iter = Iterator->new(sub + { + die "what the heck?" + if $internal > 2; + return $internal++; + }); +}; +is ($@, q{}, q{User-error iterator created fine.}); + +eval +{ + $val = $iter->value; +}; +is ($@, q{}, q{User-error iterator; first value no error.}); +cmp_ok ($val, '==', 1, q{User-error iterator; first value correct}); + +eval +{ + $val = $iter->value; +}; +isnt ($@, q{}, q{User-error iterator blew up on time}); +$x = $@; +ok (Iterator::X->caught(), q{User-error base exception caught}); +ok (Iterator::X::User_Code_Error->caught(), q{User-error specific exception caught}); +begins_with ($x, "what the heck?", q{User-error; proper string value.});