├── .gitignore ├── Changes ├── MANIFEST ├── MANIFEST.SKIP ├── Makefile.PL ├── README ├── lib └── autobox │ └── Core.pm └── t ├── added.t ├── array-slice.t ├── bless.t ├── center.t ├── chomp.t ├── chop.t ├── chr.t ├── concat.t ├── crypt.t ├── curry.t ├── each.t ├── elements.t ├── elems.t ├── first_index.t ├── flatten.t ├── flip.t ├── for.t ├── foreach.t ├── grep.t ├── head.t ├── index.t ├── join.t ├── keys.t ├── last_index.t ├── lc.t ├── lcfirst.t ├── length.t ├── m.t ├── map.t ├── nm.t ├── number.t ├── numeric.t ├── ord.t ├── pack.t ├── pop.t ├── print.t ├── push.t ├── quotemeta.t ├── range.t ├── ref.t ├── reverse.t ├── rindex.t ├── s.t ├── say.t ├── scalar.t ├── shift.t ├── size.t ├── slice.t ├── sort.t ├── split.t ├── sprintf.t ├── strip.t ├── substr.t ├── synopsis.t ├── system.t ├── tail.t ├── uc.t ├── ucfirst.t ├── undef.t ├── uniq.t ├── unpack.t ├── unshift.t ├── values.t └── vec.t /.gitignore: -------------------------------------------------------------------------------- 1 | *.swp 2 | *.swo 3 | *.tmp 4 | *.bak 5 | blib/ 6 | Makefile 7 | pm_to_blib 8 | cover_db 9 | *.gz 10 | nytprof/ 11 | .prove 12 | autobox-Core* 13 | .build 14 | MYMETA.* 15 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for autobox::Core 2 | 3 | 1.32 4 | Docs 5 | - Corrected spelling mistake (thanks again Gregor Herrmann) 6 | 7 | 1.31 8 | Docs 9 | - Corrected spelling mistake (thanks Gregor Herrmann) 10 | - Document that strings work as regexen (thanks jarich) 11 | 12 | New Features 13 | - Call backtick() qx() instead (but keep backtick around) (thanks jarich) 14 | 15 | Incompatible Changes 16 | - s() now returns the modified string or success/fail depending on context 17 | 18 | Fix 19 | - m() and nm() were failing to signal failure (thanks grtodd!) 20 | 21 | 1.30 22 | New Features 23 | - first() arguments are now consistent with grep(), so now you can 24 | supply single non-ref scalar to it (xenu) 25 | 26 | Incompatible Changes 27 | - Removed smartmatch from first() and grep(). Now these methods have 28 | consistent behaviour under all perl versions and their code is much 29 | cleaner (xenu) 30 | 31 | Docs 32 | - Fixed typo reported by myfwhite on annocpan (xenu) 33 | 34 | 1.29 35 | Fix 36 | - Suppress smartmatch deprecation warnings in perls >= 5.18 (xenu) 37 | 38 | 1.28 39 | Misc 40 | - Make crypt() test optional for platforms without it (thanks Hugmeir) 41 | 42 | 1.27 43 | Misc 44 | - new version just to creage a new .tar.gz. a './' owned by root 45 | apparently got added to the tar at some point after 'make dist'. 46 | 47 | 1.26 48 | Fix 49 | - remove 'use feature' from t/synopsis.t. this lets older perls perl. 50 | 51 | 1.25 Wed Jun 12 14:45:54 CDT 2013 52 | Fix 53 | - remove 'use feature' from t/synopsis.t. that was cut and paste from the 54 | docs but wasn't actually necessary there. 55 | 56 | 1.24 Sun Jul 15 11:05:11 PDT 2012 57 | Misc 58 | - MANIFEST no longer includes previous distribution tar balls (Jacinta 59 | Richardson) 60 | 61 | 1.23 Thu Jul 12 18:05:46 PDT 2012 62 | Docs 63 | - Minor corrections (Jacinta Richardson) 64 | 65 | 1.22 Thu Jul 12 17:16:06 PDT 2012 66 | New Features 67 | - %hash->each is now guaranteed to iterate through the complete hash, 68 | unlike each(%hash). [github 7] 69 | - defined() 70 | 71 | Distribution Changes 72 | - Added Test::More 0.88 as a pre-req (Jacinta Richardson) 73 | - Added license for new versions of EMM 74 | 75 | Docs 76 | - Expanded module synopsis (Jacinta Richardson) 77 | - Wrote documentation for all (or most) functions 78 | - Tidied book extract (Jacinta Richardson) 79 | 80 | Incompatible changes (Jacinta Richardson) 81 | - Removed functions 82 | - rand 83 | - times 84 | - add 85 | - band 86 | - bor 87 | - bxor 88 | - div 89 | - eq 90 | - flip 91 | - ge 92 | - gt 93 | - le 94 | - lshift 95 | - mult 96 | - mcmp 97 | - ne 98 | - meq 99 | - mge 100 | - mgt 101 | - mle 102 | - mlt 103 | - mne 104 | - rshift 105 | - sub 106 | - autobox::Core::CODE::map 107 | 108 | Bug Fixes 109 | - xor uses xor instead of ^ (Jacinta Richardson) 110 | 111 | 1.21 Mon Sep 26 16:15:19 PDT 2011 112 | New Features 113 | - $string->reverse will now always reverse the string regardless of context. 114 | (Technically an incompatible change, but the list behavior of $string->reverse 115 | was clearly useless). 116 | 117 | Distribution Changes 118 | - fix MANIFEST (thanks Steffen Müller). 119 | - move POD History section into standard Changes file (chocolateboy). 120 | - look, a change log! 121 | 122 | Misc 123 | - removed unnecessary prototypes on methods (schwern) 124 | - updated dependency on autobox 125 | 126 | 127 | 1.2 Fri Mar 19 12:11:00 2010 128 | - fixes version 1.1 losing the MANIFEST and being essentially 129 | a null upload. Bah! 130 | - merges in brunov's flip, center, last_index, slice, 131 | range, documentation, and various bug fixes. 132 | 133 | 1.1 Thu Mar 18 13:33:00 2010 134 | - actually adds the tests to the MANIFEST so they get bundled. 135 | - Thanks to http://github.com/daxim daxim/Lars DIECKOW for clearing 136 | out the RT queue (which I didn't know existed), merging in the fixes and 137 | features that still applied, which were several. 138 | 139 | 1.0 Sun Mar 7 22:35:00 2010 140 | - is identical to 0.9. PAUSE tells me 0.9 already exists so 141 | bumping the number. *^%$! 142 | 143 | 0.10 Mon Jan 25 17:18:00 2010 144 | - no change recorded. 145 | 146 | 0.9 Mon Jan 25 17:07:00 2010 147 | - is identical to 0.8. PAUSE tells me 0.8 already exists so bumping the number. 148 | 149 | 0.8 Mon Jan 25 14:28:00 2010 150 | - fixes unshift and pop to again return the value removed 151 | (oops, thanks brunov) and adds many, many more tests (wow, thanks brunov!). 152 | 153 | 0.7 Thu Mar 4 23:07:00 2010 154 | - uses autobox itself so you don't have to, as requested, and 155 | ... oh hell. I started editing this to fix Schwern's reported v-string 156 | warning, but I'm not seeing it. 157 | - Use ~~ on @array->grep if we're using 5.10 or newer. 158 | - Add an explicit LICENSE section per request. 159 | - Took many tests and utility functions from perl5i. 160 | - Pays attention to wantarray and returns a list or the reference, as dictated by context. 161 | - flatten should rarely if ever be needed any more. 162 | 163 | 0.6 Mon May 26 05:19:00 2008 164 | - propogates arguments to autobox and doesn't require you to use 165 | autobox. I still can't test it and am applying patches blindly. Maybe I'll 166 | drop the Hash::Util dep in the next version since it and Scalar::Util are 167 | constantly wedging on my system. 168 | The documentation needs to be updated and mention of Perl6::Contexts mostly removed. 169 | - JJ contributed a strip method for scalars - thanks JJ! 170 | 171 | 0.5 Tue May 13 23:59:00 2008 172 | - has an $arrayref->unshift bug fix and and a new flatten method for hashes. 173 | - this version is untested because my Hash::Util stopped working, dammit. 174 | 175 | 0.4 Sat Jan 5 17:00:00 2008 176 | - got numeric operations. 177 | 178 | 0.3 Wed Jan 5 21:12:00 2005 179 | - fixes a problem where unpack wasn't sure it had enough arguments 180 | according to a test introduced in Perl 5.8.6 or perhaps 5.8.5. 181 | This problem was reported by Ron Reidy - thanks Ron! 182 | - added the references to Perl 6 Now and the excerpt. 183 | 184 | 0.2 Sat May 29 21:42:00 2004 185 | - rounded out the API and introduced the beginnings of functional-ish methods. 186 | 187 | 0.1 Tue Mar 30 09:51:00 2004 188 | - woefully incomplete initial version. 189 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | Changes 2 | lib/autobox/Core.pm 3 | Makefile.PL 4 | MANIFEST This list of files 5 | MANIFEST.SKIP 6 | README 7 | t/added.t 8 | t/array-slice.t 9 | t/bless.t 10 | t/center.t 11 | t/chomp.t 12 | t/chop.t 13 | t/chr.t 14 | t/concat.t 15 | t/crypt.t 16 | t/curry.t 17 | t/each.t 18 | t/elements.t 19 | t/elems.t 20 | t/first_index.t 21 | t/flatten.t 22 | t/flip.t 23 | t/for.t 24 | t/foreach.t 25 | t/grep.t 26 | t/head.t 27 | t/index.t 28 | t/join.t 29 | t/keys.t 30 | t/last_index.t 31 | t/lc.t 32 | t/lcfirst.t 33 | t/length.t 34 | t/m.t 35 | t/map.t 36 | t/nm.t 37 | t/number.t 38 | t/numeric.t 39 | t/ord.t 40 | t/pack.t 41 | t/pop.t 42 | t/print.t 43 | t/push.t 44 | t/quotemeta.t 45 | t/range.t 46 | t/ref.t 47 | t/reverse.t 48 | t/rindex.t 49 | t/s.t 50 | t/say.t 51 | t/scalar.t 52 | t/shift.t 53 | t/size.t 54 | t/slice.t 55 | t/sort.t 56 | t/split.t 57 | t/sprintf.t 58 | t/strip.t 59 | t/substr.t 60 | t/synopsis.t 61 | t/system.t 62 | t/tail.t 63 | t/uc.t 64 | t/ucfirst.t 65 | t/undef.t 66 | t/unpack.t 67 | t/unshift.t 68 | t/values.t 69 | t/vec.t 70 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | 2 | #!start included /Users/schwern/perl5/perlbrew/perls/perl-5.14.1/lib/5.14.1/ExtUtils/MANIFEST.SKIP 3 | # Avoid version control files. 4 | \bRCS\b 5 | \bCVS\b 6 | \bSCCS\b 7 | ,v$ 8 | \B\.svn\b 9 | \B\.git\b 10 | \B\.gitignore\b 11 | \b_darcs\b 12 | \B\.cvsignore$ 13 | 14 | # Avoid VMS specific MakeMaker generated files 15 | \bDescrip.MMS$ 16 | \bDESCRIP.MMS$ 17 | \bdescrip.mms$ 18 | 19 | # Avoid Makemaker generated and utility files. 20 | \bMANIFEST\.bak 21 | \bMakefile$ 22 | \bblib/ 23 | \bMakeMaker-\d 24 | \bpm_to_blib\.ts$ 25 | \bpm_to_blib$ 26 | \bblibdirs\.ts$ # 6.18 through 6.25 generated this 27 | 28 | # Avoid Module::Build generated and utility files. 29 | \bBuild$ 30 | \b_build/ 31 | \bBuild.bat$ 32 | \bBuild.COM$ 33 | \bBUILD.COM$ 34 | \bbuild.com$ 35 | 36 | # Avoid temp and backup files. 37 | ~$ 38 | \.old$ 39 | \#$ 40 | \b\.# 41 | \.bak$ 42 | \.tmp$ 43 | \.# 44 | \.rej$ 45 | 46 | # Avoid OS-specific files/dirs 47 | # Mac OSX metadata 48 | \B\.DS_Store 49 | # Mac OSX SMB mount metadata files 50 | \B\._ 51 | 52 | # Avoid Devel::Cover and Devel::CoverX::Covered files. 53 | \bcover_db\b 54 | \bcovered\b 55 | 56 | # Avoid MYMETA files 57 | ^MYMETA\. 58 | #!end included /Users/schwern/perl5/perlbrew/perls/perl-5.14.1/lib/5.14.1/ExtUtils/MANIFEST.SKIP 59 | 60 | # avoid including tar balls from previous releases 61 | ^autobox-Core- 62 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use ExtUtils::MakeMaker; 5 | 6 | # See lib/ExtUtils/MakeMaker.pm for details of how to influence 7 | # the contents of the Makefile that is written. 8 | WriteMakefile( 9 | NAME => 'autobox::Core', 10 | VERSION_FROM => 'lib/autobox/Core.pm', # finds $VERSION 11 | PREREQ_PM => { 12 | autobox => 2.86, 13 | 'Test::More' => 0.88, 14 | Want => 0.29, 15 | }, 16 | ABSTRACT_FROM => 'lib/autobox/Core.pm', # retrieve abstract from module 17 | AUTHOR => 'Scott Walters scott@slowass.net', 18 | (eval($ExtUtils::MakeMaker::VERSION) >= 6.31 ? (LICENSE => 'perl') : ()), 19 | CONFIGURE_REQUIRES => { 20 | 'ExtUtils::MakeMaker' => '6.46', # for META_MERGE 21 | }, 22 | META_MERGE => { 23 | resources => { 24 | bugtracker => 'http://github.com/scrottie/autobox-Core/issues', 25 | repository => 'http://github.com/scrottie/autobox-Core', 26 | } 27 | }, 28 | ); 29 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | NAME 2 | autobox::Core - Provide core functions to autoboxed scalars, arrays and 3 | hashes. 4 | 5 | SYNOPSIS 6 | use autobox::Core; 7 | 8 | "Hello, World\n"->uc->print; 9 | 10 | my @list = (1, 5, 9, 2, 0, 4, 2, 1); 11 | @list->sort->reverse->print; 12 | 13 | # works with references too! 14 | my $list = [1, 5, 9, 2, 0, 4, 2, 1]; 15 | $list->sort->reverse->print; 16 | 17 | my %hash = ( 18 | grass => 'green', 19 | apple => 'red', 20 | sky => 'blue', 21 | ); 22 | 23 | [10, 20, 30, 40, 50]->pop->say; 24 | [10, 20, 30, 40, 50]->shift->say; 25 | 26 | my $lala = "Lalalalala\n"; 27 | "chomp: "->concat($lala->chomp, " ", $lala)->say; 28 | 29 | my $hashref = { foo => 10, bar => 20, baz => 30, qux => 40 }; 30 | 31 | print "hash keys: ", $hashref->keys->join(' '), "\n"; # or if you prefer... 32 | print "hash keys: ", join ' ', $hashref->keys(), "\n"; # or 33 | print "hash keys: "; $hashref->keys->say; 34 | 35 | DESCRIPTION 36 | The autobox module promotes Perl's primitive types (literals (strings 37 | and numbers), scalars, arrays and hashes) into first-class objects. 38 | However, autobox does not provide any methods for these new classes. 39 | 40 | autobox::CORE provides a set of methods for these new classes. It 41 | includes almost everything in perlfunc, some things from Scalar::Util 42 | and List::Util, and some Perl 5 versions of methods taken from Perl 6. 43 | 44 | With autobox::Core one is able to change this: 45 | 46 | print join(" ", reverse(split(" ", $string))); 47 | 48 | to this: 49 | 50 | use autobox::Core; 51 | 52 | $string->split(" ")->reverse->print; 53 | 54 | Likewise you can change this: 55 | 56 | my $array_ref = [qw(fish dog cat elephant bird)]; 57 | 58 | push @$array_ref, qw(snake lizard giraffe mouse); 59 | 60 | to this: 61 | 62 | use autobox::Core; 63 | my $array_ref = [qw(fish dog cat elephant bird)]; 64 | 65 | $array_ref->push( qw(snake lizard giraffe mouse)); 66 | 67 | autobox::Core makes it easier to avoid parentheses pile ups and messy 68 | dereferencing syntaxes. 69 | 70 | autobox::Core is mostly glue. It presents existing functions with a new 71 | interface, while adding few extra. Most of the methods read like "sub 72 | hex { CORE::hex($_[0]) }". In addition to built-ins from perlfunc that 73 | operate on hashes, arrays, scalars, and code references, some Perl 6-ish 74 | things have been included, and some keywords like "foreach" are 75 | represented too. 76 | 77 | What's Implemented? 78 | * Many of the functions listed in perlfunc under the headings: 79 | 80 | * "Functions for real @ARRAYs", 81 | 82 | * "Functions for real %HASHes", 83 | 84 | * "Functions for list data", 85 | 86 | * "Functions for SCALARs or strings" 87 | 88 | plus a few taken from other sections and documented below. 89 | 90 | * Some methods from Scalar::Util and List::Util. 91 | 92 | * Some things expected in Perl 6, such as "last" ("last_idx"), 93 | "elems", and "curry". 94 | 95 | * "flatten" explicitly flattens an array. 96 | 97 | String Methods 98 | String methods are of the form "my $return = $string->method(@args)". 99 | Some will act on the $string and some will return a new string. 100 | 101 | Many string methods are simply wrappers around core functions, but there 102 | are additional operations and modifications to core behavior. 103 | 104 | Anything which takes a regular expression, such as split and m, usually 105 | take it in the form of a compiled regex ("qr//"). Any modifiers can be 106 | attached to the "qr" normally. Bare strings may be used in place of 107 | regular expressions, and Perl will compile it to a regex, as usual. 108 | 109 | These built in functions are implemented for scalars, they work just 110 | like normal: chomp, chop,chr crypt, index, lc lcfirst, length, ord, 111 | pack, reverse (always in scalar context), rindex, sprintf, substr, uc 112 | ucfirst, unpack, quotemeta, vec, undef, split, system, eval. 113 | 114 | In addition, so are each of the following: 115 | 116 | concat 117 | $string1->concat($string2); 118 | 119 | Concatenates $string2 to $string1. This corresponds to the "." operator 120 | used to join two strings. Returns the joined strings. 121 | 122 | strip 123 | Removes whitespace from the beginning and end of a string. 124 | 125 | " \t \n \t foo \t \n \t "->strip; # foo 126 | 127 | This is redundant and subtly different from "trim" which allows for the 128 | removal of specific characters from the beginning and end of a string. 129 | 130 | trim 131 | Removes whitespace from the beginning and end of a string. "trim" can 132 | also remove specific characters from the beginning and the end of 133 | string. 134 | 135 | ' hello'->trim; # 'hello' 136 | '*+* hello *+*'->trim("*+"); # ' hello ' 137 | ' *+* hello *+*'->trim("*+"); # ' *+* hello' 138 | 139 | ltrim 140 | Just like trim but it only trims the left side (start) of the string. 141 | 142 | ' hello'->ltrim; # 'hello' 143 | '*+* hello *+*'->ltrim("*+"); # ' hello *+*' 144 | 145 | rtrim 146 | Just like trim but it only trims the right side (end) of the string. 147 | 148 | 'hello '->rtrim; # 'hello' 149 | '*+* hello *+*'->rtrim("*+"); # '*+* hello ' 150 | 151 | split 152 | my @split_string = $string->split(qr/.../); 153 | my @split_string = $string->split(' '); 154 | 155 | A wrapper around split. It takes the regular expression as a compiled 156 | regex, or a string which Perl parses as a regex. 157 | 158 | print "10, 20, 30, 40"->split(qr{, ?})->elements, "\n"; 159 | "hi there"->split(qr/ */); # h i t h e r e 160 | 161 | The limit argument is not implemented. 162 | 163 | title_case 164 | "title_case" converts the first character of each word in the string to 165 | upper case. 166 | 167 | "this is a test"->title_case; # This Is A Test 168 | 169 | center 170 | my $centered_string = $string->center($length); 171 | my $centered_string = $string->center($length, $character); 172 | 173 | Centers $string between $character. $centered_string will be of length 174 | $length, or the length of $string, whichever is greater. 175 | 176 | $character defaults to " ". 177 | 178 | say "Hello"->center(10); # " Hello "; 179 | say "Hello"->center(10, '-'); # "---Hello--"; 180 | 181 | "center()" will never truncate $string. If $length is less than 182 | "$string->length" it will just return $string. 183 | 184 | say "Hello"->center(4); # "Hello"; 185 | 186 | qx 187 | my $output = $string->qx; 188 | 189 | Runs $string as a command just enclosing it backticks, as in `$string`. 190 | 191 | nm 192 | if( $foo->nm(qr/bar/) ) { 193 | say "$foo did not match 'bar'"; 194 | } 195 | 196 | "Negative match". Corresponds to "!~". Otherwise works in the same way 197 | as "m()". 198 | 199 | m 200 | if( $foo->m(qr/bar/) ) { 201 | say "$foo matched 'bar'"; 202 | } 203 | 204 | my $matches = $foo->m( qr/(\d*) (\w+)/ ); 205 | say $matches->[0]; 206 | say $matches->[1]; 207 | 208 | Works the same as "m//", but the regex must be passed in as a "qr//". 209 | 210 | "m" returns an array reference so that list functions such as "map" and 211 | "grep" may be called on the result. Use "elements" to turn this into a 212 | list of values. 213 | 214 | my ($street_number, $street_name, $apartment_number) = 215 | "1234 Robin Drive #101"->m( qr{(\d+) (.*)(?: #(\d+))?} )->elements; 216 | 217 | print "$street_number $street_name $apartment_number\n"; 218 | 219 | s 220 | my $string = "the cat sat on the mat"; 221 | $string->s( qr/cat/, "dog" ); 222 | $string->say; # the dog sat on the mat 223 | 224 | String substitution. Works similarly to "s///". In boolean context, it 225 | returns true/false to indicate whether the substitution succeeded. "if", 226 | "?:", "!", and so on, all provide boolean context. It either fails or 227 | succeeds, having replaced only one occurrence on success -- it doesn't 228 | replace globally. In scalar context other than boolean context, it 229 | returns the modified string (incompatible change, new as of v 1.31). 230 | 231 | undef 232 | $string->undef; 233 | 234 | Assigns "undef" to the $string. 235 | 236 | defined 237 | my $is_defined = $string->defined; 238 | 239 | if( not $string->defined ) { 240 | # give $string a value... 241 | } 242 | 243 | "defined" tests whether a value is defined (not "undef"). 244 | 245 | repeat 246 | my $repeated_string = $string->repeat($n); 247 | 248 | Like the "x" operator, repeats a string $n times. 249 | 250 | print 1->repeat(5); # 11111 251 | print "\n"->repeat(10); # ten newlines 252 | 253 | I/O Methods 254 | These are methods having to do with input and ouptut, not filehandles. 255 | 256 | print 257 | $string->print; 258 | 259 | Prints a string or a list of strings. Returns true if successful. 260 | 261 | say 262 | Like print, but implicitly appends a newline to the end. 263 | 264 | $string->say; 265 | 266 | Boolean Methods 267 | Methods related to boolean operations. 268 | 269 | and 270 | "and" corresponds to "&&". Returns true if both operands are true. 271 | 272 | if( $a->and($b) ) { 273 | ... 274 | } 275 | 276 | not 277 | "not" corresponds to "!". Returns true if the subject is false. 278 | 279 | if( $a->not ) { 280 | ... 281 | } 282 | 283 | or 284 | "or" corresponds to "||". Returns true if at least one of the operands 285 | is true. 286 | 287 | if( $a->or($b) ) { 288 | ... 289 | } 290 | 291 | xor 292 | "xor" corresponds to "xor". Returns true if only one of the operands is 293 | true. 294 | 295 | if( $a->xor($b) ) { 296 | ... 297 | } 298 | 299 | Number Related Methods 300 | Methods related to numbers. 301 | 302 | The basic built in functions which operate as normal : abs, atan2, cos, 303 | exp, int, log, oct, hex, sin, and sqrt. 304 | 305 | The following operators were also included: 306 | 307 | dec 308 | $number->dec(); 309 | # $number is smaller by 1. 310 | 311 | "dec" corresponds to "++". Decrements subject, will decrement character 312 | strings too: 'b' decrements to 'a'. 313 | 314 | inc 315 | "inc" corresponds to "++". Increments subject, will increment character 316 | strings too. 'a' increments to 'b'. 317 | 318 | mod 319 | "mod" corresponds to "%". 320 | 321 | $number->mod(5); 322 | 323 | pow 324 | "pow" returns $number raised to the power of the $exponent. 325 | 326 | my $result = $number->pow($expontent); 327 | print 2->pow(8); # 256 328 | 329 | is_number 330 | $is_a_number = $thing->is_number; 331 | 332 | Returns true if $thing is a number as understood by Perl. 333 | 334 | 12.34->is_number; # true 335 | "12.34"->is_number; # also true 336 | 337 | is_positive 338 | $is_positive = $thing->is_positive; 339 | 340 | Returns true if $thing is a positive number. 341 | 342 | 0 is not positive. 343 | 344 | is_negative 345 | $is_negative = $thing->is_negative; 346 | 347 | Returns true if $thing is a negative number. 348 | 349 | 0 is not negative. 350 | 351 | is_integer 352 | $is_an_integer = $thing->is_integer; 353 | 354 | Returns true if $thing is an integer. 355 | 356 | 12->is_integer; # true 357 | 12.34->is_integer; # false 358 | 359 | is_int 360 | A synonym for is_integer. 361 | 362 | is_decimal 363 | $is_a_decimal_number = $thing->is_decimal; 364 | 365 | Returns true if $thing is a decimal number. 366 | 367 | 12->is_decimal; # false 368 | 12.34->is_decimal; # true 369 | ".34"->is_decimal; # true 370 | 371 | Reference Related Methods 372 | The following core functions are implemented. 373 | 374 | tie, tied, ref, vec. 375 | 376 | "tie", "tied", and "undef" don't work on code references. 377 | 378 | Array Methods 379 | Array methods work on both arrays and array references: 380 | 381 | my $arr = [ 1 .. 10 ]; 382 | $arr->undef; 383 | 384 | Or: 385 | 386 | my @arr = ( 1 .. 10 ); 387 | @arr->undef; 388 | 389 | List context forces methods to return a list: 390 | 391 | my @arr = ( 1 .. 10 ); 392 | print join ' -- ', @arr->grep(sub { $_ > 3 }), "\n"; 393 | 394 | Likewise, scalar context forces methods to return an array reference. 395 | 396 | As scalar context forces methods to return a reference, methods may be 397 | chained 398 | 399 | my @arr = ( 1 .. 10 ); 400 | @arr->grep(sub { $_ > 3 })->min->say; # "4\n"; 401 | 402 | These built-in functions are defined as methods: 403 | 404 | pop, push, shift, unshift, delete, undef, exists, bless, tie, tied, ref, 405 | grep, map, join, reverse, and sort, each. 406 | 407 | As well as: 408 | 409 | vdelete 410 | Deletes a specified value from the array. 411 | 412 | $a = 1->to(10); 413 | $a->vdelete(3); # deletes 3 414 | $a->vdelete(2)->say; # "1 4 5 6 7 8 9 10\n" 415 | 416 | uniq 417 | Removes all duplicate elements from an array and returns the new array 418 | with no duplicates. 419 | 420 | my @array = qw( 1 1 2 3 3 6 6 ); 421 | @return = @array->uniq; # @return : 1 2 3 6 422 | 423 | first 424 | Returns the first element of an array for which a callback returns true: 425 | 426 | $arr->first(sub { qr/5/ }); 427 | 428 | max 429 | Returns the largest numerical value in the array. 430 | 431 | $a = 1->to(10); 432 | $a->max; # 10 433 | 434 | min 435 | Returns the smallest numerical value in the array. 436 | 437 | $a = 1->to(10); 438 | $a->min; # 1 439 | 440 | mean 441 | Returns the mean of elements of an array. 442 | 443 | $a = 1->to(10); 444 | $a->mean; # 55/10 445 | 446 | var 447 | Returns the variance of the elements of an array. 448 | 449 | $a = 1->to(10); 450 | $a->var; # 33/4 451 | 452 | svar 453 | Returns the standard variance. 454 | 455 | $a = 1->to(10); 456 | $a->svar; # 55/6 457 | 458 | at 459 | Returns the element at a specified index. This function does not modify 460 | the original array. 461 | 462 | $a = 1->to(10); 463 | $a->at(2); # 3 464 | 465 | size, elems, length 466 | "size", "elems" and "length" all return the number of elements in an 467 | array. 468 | 469 | my @array = qw(foo bar baz); 470 | @array->size; # 3 471 | 472 | elements, flatten 473 | my @copy_of_array = $array->flatten; 474 | 475 | Returns the elements of an array ref as an array. This is the same as 476 | "@{$array}". 477 | 478 | Arrays can be iterated on using "for" and "foreach". Both take a code 479 | reference as the body of the for statement. 480 | 481 | foreach 482 | @array->foreach(\&code); 483 | 484 | Calls &code on each element of the @array in order. &code gets the 485 | element as its argument. 486 | 487 | @array->foreach(sub { print $_[0] }); # print each element of the array 488 | 489 | for 490 | @array->for(\&code); 491 | 492 | Like foreach, but &code is called with the index, the value and the 493 | array itself. 494 | 495 | my $arr = [ 1 .. 10 ]; 496 | $arr->for(sub { 497 | my($idx, $value) = @_; 498 | print "Value #$idx is $value\n"; 499 | }); 500 | 501 | sum 502 | my $sum = @array->sum; 503 | 504 | Adds together all the elements of the array. 505 | 506 | count 507 | Returns the number of elements in array that are "eq" to a specified 508 | value: 509 | 510 | my @array = qw/one two two three three three/; 511 | my $num = @array->count('three'); # returns 3 512 | 513 | to, upto, downto 514 | "to", "upto", and "downto" create array references: 515 | 516 | 1->to(5); # creates [1, 2, 3, 4, 5] 517 | 1->upto(5); # creates [1, 2, 3, 4, 5] 518 | 5->downto(5); # creates [5, 4, 3, 2, 1] 519 | 520 | Those wrap the ".." operator. 521 | 522 | Note while working with negative numbers you need to use () so as to 523 | avoid the wrong evaluation. 524 | 525 | my $range = 10->to(1); # this works 526 | my $range = -10->to(10); # wrong, interpreted as -( 10->to(10) ) 527 | my $range = (-10)->to(10); # this works 528 | 529 | head 530 | Returns the first element from @list. This differs from shift in that it 531 | does not change the array. 532 | 533 | my $first = @list->head; 534 | 535 | tail 536 | Returns all but the first element from @list. 537 | 538 | my @list = qw(foo bar baz quux); 539 | my @rest = @list->tail; # [ 'bar', 'baz', 'quux' ] 540 | 541 | Optionally, you can pass a number as argument to ask for the last $n 542 | elements: 543 | 544 | @rest = @list->tail(2); # [ 'baz', 'quux' ] 545 | 546 | slice 547 | Returns a list containing the elements from @list at the indices 548 | @indices. In scalar context, returns an array reference. 549 | 550 | # Return $list[1], $list[2], $list[4] and $list[8]. 551 | my @sublist = @list->slice(1,2,4,8); 552 | 553 | range 554 | "range" returns a list containing the elements from @list with indices 555 | ranging from $lower_idx to $upper_idx. It returns an array reference in 556 | scalar context. 557 | 558 | my @sublist = @list->range( $lower_idx, $upper_idx ); 559 | 560 | last_index 561 | my $index = @array->last_index(qr/.../); 562 | 563 | Returns the highest index whose element matches the given regular 564 | expression. 565 | 566 | my $index = @array->last_index(\&filter); 567 | 568 | Returns the highest index for an element on which the filter returns 569 | true. The &filter is passed in each value of the @array. 570 | 571 | my @things = qw(pear poll potato tomato); 572 | my $last_p = @things->last_index(qr/^p/); # 2 573 | 574 | Called with no arguments, it corresponds to $#array giving the highest 575 | index of the array. 576 | 577 | my $index = @array->last_index; 578 | 579 | first_index 580 | Works just like last_index but it will return the index of the *first* 581 | matching element. 582 | 583 | my $first_index = @array->first_index; # 0 584 | 585 | my @things = qw(pear poll potato tomato); 586 | my $last_p = @things->first_index(qr/^t/); # 3 587 | 588 | at 589 | my $value = $array->at($index); 590 | 591 | Equivalent to "$array->[$index]". 592 | 593 | Hash Methods 594 | Hash methods work on both hashes and hash references. 595 | 596 | The built in functions work as normal: 597 | 598 | delete, exists, keys, values, bless, tie, tied, ref, undef, 599 | 600 | at, get 601 | my @values = %hash->get(@keys); 602 | 603 | Returns the @values of @keys. 604 | 605 | put 606 | %hash->put(%other_hash); 607 | 608 | Overlays %other_hash on top of %hash. 609 | 610 | my $h = {a => 1, b => 2}; 611 | $h->put(b => 99, c => 3); # (a => 1, b => 99, c => 3) 612 | 613 | set 614 | Synonym for put. 615 | 616 | each 617 | Like "foreach" but for hash references. For each key in the hash, the 618 | code reference is invoked with the key and the corresponding value as 619 | arguments: 620 | 621 | my $hashref = { foo => 10, bar => 20, baz => 30, quux => 40 }; 622 | $hashref->each(sub { print $_[0], ' is ', $_[1], "\n" }); 623 | 624 | Or: 625 | 626 | my %hash = ( foo => 10, bar => 20, baz => 30, quux => 40 ); 627 | %hash->each(sub { print $_[0], ' is ', $_[1], "\n" }); 628 | 629 | Unlike regular "each", this each will always iterate through the entire 630 | hash. 631 | 632 | Hash keys appear in random order that varies from run to run (this is 633 | intentional, to avoid calculated attacks designed to trigger algorithmic 634 | worst case scenario in "perl"'s hash tables). 635 | 636 | You can get a sorted "foreach" by combining "keys", "sort", and 637 | "foreach": 638 | 639 | %hash->keys->sort->foreach(sub { 640 | print $_[0], ' is ', $hash{$_[0]}, "\n"; 641 | }); 642 | 643 | lock_keys 644 | %hash->lock_keys; 645 | 646 | Works as "lock_keys" in Hash::Util. No more keys may be added to the 647 | hash. 648 | 649 | slice 650 | Takes a list of hash keys and returns the corresponding values e.g. 651 | 652 | my %hash = ( 653 | one => 'two', 654 | three => 'four', 655 | five => 'six' 656 | ); 657 | 658 | print %hash->slice(qw(one five))->join(' and '); # prints "two and six" 659 | 660 | flip 661 | Exchanges values for keys in a hash: 662 | 663 | my %things = ( foo => 1, bar => 2, baz => 5 ); 664 | my %flipped = %things->flip; # { 1 => foo, 2 => bar, 5 => baz } 665 | 666 | If there is more than one occurrence of a certain value, any one of the 667 | keys may end up as the value. This is because of the random ordering of 668 | hash keys. 669 | 670 | # Could be { 1 => foo }, { 1 => bar }, or { 1 => baz } 671 | { foo => 1, bar => 1, baz => 1 }->flip; 672 | 673 | Because references cannot usefully be keys, it will not work where the 674 | values are references. 675 | 676 | { foo => [ 'bar', 'baz' ] }->flip; # dies 677 | 678 | flatten 679 | my %hash = $hash_ref->flatten; 680 | 681 | Dereferences a hash reference. 682 | 683 | Code Methods 684 | Methods which work on code references. 685 | 686 | These are simple wrappers around the Perl core functions. bless, ref, 687 | 688 | Due to Perl's precedence rules, some autoboxed literals may need to be 689 | parenthesized. For instance, this works: 690 | 691 | my $curried = sub { ... }->curry(); 692 | 693 | This does not: 694 | 695 | my $curried = \&foo->curry(); 696 | 697 | The solution is to wrap the reference in parentheses: 698 | 699 | my $curried = (\&foo)->curry(); 700 | 701 | curry 702 | my $curried_code = $code->curry(5); 703 | 704 | Currying takes a code reference and provides the same code, but with the 705 | first argument filled in. 706 | 707 | my $greet_world = sub { 708 | my($greeting, $place) = @_; 709 | return "$greeting, $place!"; 710 | }; 711 | print $greet_world->("Hello", "world"); # "Hello, world!" 712 | 713 | my $howdy_world = $greet_world->curry("Howdy"); 714 | print $howdy_world->("Texas"); # "Howdy, Texas!" 715 | 716 | What's Missing? 717 | * File and socket operations are already implemented in an 718 | object-oriented fashion care of IO::Handle, IO::Socket::INET, and 719 | IO::Any. 720 | 721 | * Functions listed in the perlfunc headings 722 | 723 | * "System V interprocess communication functions", 724 | 725 | * "Fetching user and group info", 726 | 727 | * "Fetching network info", 728 | 729 | * "Keywords related to perl modules", 730 | 731 | * "Functions for processes and process groups", 732 | 733 | * "Keywords related to scoping", 734 | 735 | * "Time-related functions", 736 | 737 | * "Keywords related to the control flow of your perl program", 738 | 739 | * "Functions for filehandles, files, or directories", 740 | 741 | * "Input and output functions". 742 | 743 | * (Most) binary operators 744 | 745 | These things are likely implemented in an object oriented fashion by 746 | other CPAN modules, are keywords and not functions, take no arguments, 747 | or don't make sense as part of the string, number, array, hash, or code 748 | API. 749 | 750 | Autoboxing 751 | *This section quotes four pages from the manuscript of Perl 6 Now: The 752 | Core Ideas Illustrated with Perl 5 by Scott Walters. The text appears in 753 | the book starting at page 248. This copy lacks the benefit of copyedit - 754 | the finished product is of higher quality.* 755 | 756 | A *box* is an object that contains a primitive variable. Boxes are used 757 | to endow primitive types with the capabilities of objects which 758 | essential in strongly typed languages but never strictly required in 759 | Perl. Programmers might write something like "my $number = Int->new(5)". 760 | This is manual boxing. To *autobox* is to convert a simple type into an 761 | object type automatically, or only conceptually. This is done by the 762 | language. 763 | 764 | *autobox*ing makes a language look to programmers as if everything is an 765 | object while the interpreter is free to implement data storage however 766 | it pleases. Autoboxing is really making simple types such as numbers, 767 | strings, and arrays appear to be objects. 768 | 769 | "int", "num", "bit", "str", and other types with lower case names, are 770 | primitives. They're fast to operate on, and require no more memory to 771 | store than the data held strictly requires. "Int", "Num", "Bit", "Str", 772 | and other types with an initial capital letter, are objects. These may 773 | be subclassed (inherited from) and accept traits, among other things. 774 | These objects are provided by the system for the sole purpose of 775 | representing primitive types as objects, though this has many ancillary 776 | benefits such as making "is" and "has" work. Perl provides "Int" to 777 | encapsulate an "int", "Num" to encapsulate a "num", "Bit" to encapsulate 778 | a "bit", and so on. As Perl's implementations of hashes and dynamically 779 | expandable arrays store any type, not just objects, Perl programmers 780 | almost never are required to box primitive types in objects. Perl's 781 | power makes this feature less essential than it is in other languages. 782 | 783 | *autobox*ing makes primitive objects and they're boxed versions 784 | equivalent. An "int" may be used as an "Int" with no constructor call, 785 | no passing, nothing. This applies to constants too, not just variables. 786 | This is a more Perl 6 way of doing things. 787 | 788 | # Perl 6 - autoboxing associates classes with primitives types: 789 | 790 | print 4.sqrt, "\n"; 791 | 792 | print [ 1 .. 20 ].elems, "\n"; 793 | 794 | The language is free to implement data storage however it wishes but the 795 | programmer sees the variables as objects. 796 | 797 | Expressions using autoboxing read somewhat like Latin suffixes. In the 798 | autoboxing mind-set, you might not say that something is "made more 799 | mnemonic", but has been "mnemonicified". 800 | 801 | Autoboxing may be mixed with normal function calls. In the case where 802 | the methods are available as functions and the functions are available 803 | as methods, it is only a matter of personal taste how the expression 804 | should be written: 805 | 806 | # Calling methods on numbers and strings, these three lines are equivalent 807 | # Perl 6 808 | 809 | print sqrt 4; 810 | print 4.sqrt; 811 | 4.sqrt.print; 812 | 813 | The first of these three equivalents assumes that a global "sqrt()" 814 | function exists. This first example would fail to operate if this global 815 | function were removed and only a method in the "Num" package was left. 816 | 817 | Perl 5 had the beginnings of autoboxing with filehandles: 818 | 819 | use IO::Handle; 820 | open my $file, '<', 'file.txt' or die $!; 821 | $file->read(my $data, -s $file); 822 | 823 | Here, "read" is a method on a filehandle we opened but *never blessed*. 824 | This lets us say things like "$file->print(...)" rather than the often 825 | ambagious "print $file ...". 826 | 827 | To many people, much of the time, it makes more conceptual sense as 828 | well. 829 | 830 | Reasons to Box Primitive Types 831 | What good is all of this? 832 | 833 | * Makes conceptual sense to programmers used to object interfaces as 834 | *the* way to perform options. 835 | 836 | * Alternative idiom. Doesn't require the programmer to write or read 837 | expressions with complex precedence rules or strange operators. 838 | 839 | * Many times that parenthesis would otherwise have to span a large 840 | expression, the expression may be rewritten such that the 841 | parenthesis span only a few primitive types. 842 | 843 | * Code may often be written with fewer temporary variables. 844 | 845 | * Autoboxing provides the benefits of boxed types without the memory 846 | bloat of actually using objects to represent primitives. Autoboxing 847 | "fakes it". 848 | 849 | * Strings, numbers, arrays, hashes, and so on, each have their own 850 | API. Documentation for an "exists" method for arrays doesn't have to 851 | explain how hashes are handled and vice versa. 852 | 853 | * Perl tries to accommodate the notion that the "subject" of a 854 | statement should be the first thing on the line, and autoboxing 855 | furthers this agenda. 856 | 857 | Perl is an idiomatic language and this is an important idiom. 858 | 859 | Subject First: An Aside 860 | Perl's design philosophy promotes the idea that the language should be 861 | flexible enough to allow programmers to place the subject of a statement 862 | first. For example, "die $! unless read $file, 60" looks like the 863 | primary purpose of the statement is to "die". 864 | 865 | While that might be the programmers primary goal, when it isn't, the 866 | programmer can communicate his real primary intention to programmers by 867 | reversing the order of clauses while keeping the exact same logic: "read 868 | $file, 60 or die $!". 869 | 870 | Autoboxing is another way of putting the subject first. 871 | 872 | Nouns make good subjects, and in programming, variables, constants, and 873 | object names are the nouns. Function and method names are verbs. 874 | "$noun->verb()" focuses the readers attention on the thing being acted 875 | on rather than the action being performed. Compare to "$verb($noun)". 876 | 877 | Autoboxing and Method Results 878 | Let's look at some examples of ways an expression could be written. 879 | 880 | # Various ways to do the same thing: 881 | 882 | print(reverse(sort(keys(%hash)))); # Perl 5 - pathological parenthetic 883 | print reverse sort keys %hash; # Perl 5 - no unneeded parenthesis 884 | 885 | print(reverse(sort(%hash,keys)))); # Perl 6 - pathological 886 | print reverse sort %hash.keys; # Perl 6 - no unneeded parenthesis 887 | 888 | %hash.keys ==> sort ==> reverse ==> print; # Perl 6 - pipeline operator 889 | 890 | %hash.keys.sort.reverse.print; # Perl 6 - autobox 891 | 892 | %hash->keys->sort->reverse->print; # Perl 5 - autobox 893 | 894 | This section deals with the last two of these equivalents. These are 895 | method calls 896 | 897 | use autobox::Core; 898 | use Perl6::Contexts; 899 | 900 | my %hash = (foo => 'bar', baz => 'quux'); 901 | 902 | %hash->keys->sort->reverse->print; # Perl 5 - autobox 903 | 904 | # prints "foo baz" 905 | 906 | Each method call returns an array reference, in this example. Another 907 | method call is immediately performed on this value. This feeding of the 908 | next method call with the result of the previous call is the common mode 909 | of use of autoboxing. Providing no other arguments to the method calls, 910 | however, is not common. 911 | 912 | "Perl6::Contexts" recognizes object context as provided by "->" and 913 | coerces %hash and @array into references, suitable for use with 914 | "autobox". (Note that "autobox" also does this automatically as of 915 | version 2.40.) 916 | 917 | "autobox" associates primitive types, such as references of various 918 | sorts, with classes. "autobox::Core" throws into those classes methods 919 | wrapping Perl's built-in functions. In the interest of full disclosure, 920 | "Perl6::Contexts" and "autobox::Core" are my creations. 921 | 922 | Autobox to Simplify Expressions 923 | One of my pet peeves in programming is parenthesis that span large 924 | expression. It seems like about the time I'm getting ready to close the 925 | parenthesis I opened on the other side of the line, I realize that I've 926 | forgotten something, and I have to arrow back over or grab the mouse. 927 | 928 | When the expression is too long to fit on a single line, it gets broken 929 | up, then I must decide how to indent it if it grows to 3 or more lines. 930 | 931 | # Perl 5 - a somewhat complex expression 932 | 933 | print join("\n", map { CGI::param($_) } @cgi_vars), "\n"; 934 | # Perl 5 - again, using autobox: 935 | 936 | @cgi_vars->map(sub { CGI::param($_[0]) })->join("\n")->concat("\n")->print; 937 | 938 | The autoboxed version isn't shorter, but it reads from left to right, 939 | and the parenthesis from the "join()" don't span nearly as many 940 | characters. The complex expression serving as the value being "join()"ed 941 | in the non-autoboxed version becomes, in the autoboxed version, a value 942 | to call the "join()" method on. 943 | 944 | This "print" statement takes a list of CGI parameter names, reads the 945 | values for each parameter, joins them together with newlines, and prints 946 | them with a newline after the last one. 947 | 948 | Pretending that this expression were much larger and it had to be broken 949 | to span several lines, or pretending that comments are to be placed 950 | after each part of the expression, you might reformat it as such: 951 | 952 | @cgi_vars->map(sub { CGI::param($_[0]) }) # turn CGI arg names into values 953 | ->join("\n") # join with newlines 954 | ->concat("\n") # give it a trailing newline 955 | ->print; # print them all out 956 | 957 | *Here ends the text quoted from the Perl 6 Now manuscript.* 958 | 959 | BUGS 960 | Yes. Report them to the author, scott@slowass.net, or post them to 961 | GitHub's bug tracker at 962 | . 963 | 964 | The API is not yet stable -- Perl 6-ish things and local extensions are 965 | still being renamed. 966 | 967 | HISTORY 968 | See the Changes file. 969 | 970 | COPYRIGHT AND LICENSE 971 | Copyright (C) 2009, 2010, 2011 by Scott Walters and various contributors 972 | listed (and unlisted) below. 973 | 974 | This library is free software; you can redistribute it and/or modify it 975 | under the same terms as Perl itself, either Perl version 5.8.9 or, at 976 | your option, any later version of Perl 5 you may have available. 977 | 978 | This library is distributed in the hope that it will be useful, but 979 | without any warranty; without even the implied warranty of 980 | merchantability or fitness for a particular purpose. 981 | 982 | SEE ALSO 983 | autobox 984 | Moose::Autobox 985 | Perl6::Contexts 986 | 987 | IO::Any 988 | Perl 6: . 989 | 990 | AUTHORS 991 | Scott Walters, scott@slowass.net. 992 | 993 | Tomasz Konojacki has been assisting with maint. 994 | 995 | Jacinta Richardson improved documentation and tidied up the interface. 996 | 997 | Michael Schwern and the perl5i contributors for tests, code, and 998 | feedback. 999 | 1000 | JJ contributed a "strip" method for scalars - thanks JJ! 1001 | 1002 | Ricardo SIGNES contributed patches. 1003 | 1004 | Thanks to Matt Spear, who contributed tests and definitions for numeric 1005 | operations. 1006 | 1007 | Mitchell N Charity reported a bug and sent a fix. 1008 | 1009 | Thanks to chocolateboy for autobox and for the encouragement. 1010 | 1011 | Thanks to Bruno Vecchi for bug fixes and many, many new tests going into 1012 | version 0.8. 1013 | 1014 | Thanks to daxim/Lars DIECKOW pushing in fixes 1015 | and patches from the RT queue along with fixes to build and additional 1016 | doc examples. 1017 | 1018 | Thanks to everyone else who sent fixes or suggestions -- apologies if I 1019 | failed to include you here! 1020 | 1021 | -------------------------------------------------------------------------------- /lib/autobox/Core.pm: -------------------------------------------------------------------------------- 1 | package autobox::Core; 2 | 3 | use 5.008; 4 | 5 | use strict; 6 | use warnings; 7 | 8 | our $VERSION = '1.33'; 9 | 10 | use base 'autobox'; 11 | 12 | use B; 13 | use Want (); 14 | 15 | # appending the user-supplied arguments allows autobox::Core options to be overridden 16 | # or extended in the same statement e.g. 17 | # 18 | # use autobox::Core UNDEF => 'MyUndef'; # also autobox undef 19 | # use autobox::Core CODE => undef; # don't autobox CODE refs 20 | # use autobox::Core UNIVERSAL => 'Data::Dumper'; # enable a Dumper() method for all types 21 | 22 | sub import { 23 | shift->SUPER::import(DEFAULT => 'autobox::Core::', @_); 24 | } 25 | 26 | =encoding UTF-8 27 | 28 | =head1 NAME 29 | 30 | autobox::Core - Provide core functions to autoboxed scalars, arrays and hashes. 31 | 32 | =head1 SYNOPSIS 33 | 34 | use autobox::Core; 35 | 36 | "Hello, World\n"->uc->print; 37 | 38 | my @list = (1, 5, 9, 2, 0, 4, 2, 1); 39 | @list->sort->reverse->print; 40 | 41 | # works with references too! 42 | my $list = [1, 5, 9, 2, 0, 4, 2, 1]; 43 | $list->sort->reverse->print; 44 | 45 | my %hash = ( 46 | grass => 'green', 47 | apple => 'red', 48 | sky => 'blue', 49 | ); 50 | 51 | [10, 20, 30, 40, 50]->pop->say; 52 | [10, 20, 30, 40, 50]->shift->say; 53 | 54 | my $lala = "Lalalalala\n"; 55 | "chomp: "->concat($lala->chomp, " ", $lala)->say; 56 | 57 | my $hashref = { foo => 10, bar => 20, baz => 30, qux => 40 }; 58 | 59 | print "hash keys: ", $hashref->keys->join(' '), "\n"; # or if you prefer... 60 | print "hash keys: ", join ' ', $hashref->keys(), "\n"; # or 61 | print "hash keys: "; $hashref->keys->say; 62 | 63 | =head1 DESCRIPTION 64 | 65 | The L module promotes Perl's primitive types (literals (strings and 66 | numbers), scalars, arrays and hashes) into first-class objects. However, 67 | L does not provide any methods for these new classes. 68 | 69 | L provides a set of methods for these new classes. It includes 70 | almost everything in L, some things from L and 71 | L, and some Perl 5 versions of methods taken from Perl 6. 72 | 73 | With F one is able to change this: 74 | 75 | print join(" ", reverse(split(" ", $string))); 76 | 77 | to this: 78 | 79 | use autobox::Core; 80 | 81 | $string->split(" ")->reverse->print; 82 | 83 | Likewise you can change this: 84 | 85 | my $array_ref = [qw(fish dog cat elephant bird)]; 86 | 87 | push @$array_ref, qw(snake lizard giraffe mouse); 88 | 89 | to this: 90 | 91 | use autobox::Core; 92 | my $array_ref = [qw(fish dog cat elephant bird)]; 93 | 94 | $array_ref->push( qw(snake lizard giraffe mouse)); 95 | 96 | F makes it easier to avoid parentheses pile ups and 97 | messy dereferencing syntaxes. 98 | 99 | F is mostly glue. It presents existing functions with a new 100 | interface, while adding few extra. Most of the methods read like 101 | C<< sub hex { CORE::hex($_[0]) } >>. In addition to built-ins from 102 | L that operate on hashes, arrays, scalars, and code references, 103 | some Perl 6-ish things have been included, and some keywords like 104 | C are represented too. 105 | 106 | =head2 What's Implemented? 107 | 108 | =over 4 109 | 110 | =item * 111 | 112 | Many of the functions listed in L under the headings: 113 | 114 | =over 4 115 | 116 | =item * 117 | 118 | "Functions for real @ARRAYs", 119 | 120 | =item * 121 | 122 | "Functions for real %HASHes", 123 | 124 | =item * 125 | 126 | "Functions for list data", 127 | 128 | =item * 129 | 130 | "Functions for SCALARs or strings" 131 | 132 | =back 133 | 134 | plus a few taken from other sections and documented below. 135 | 136 | =item * 137 | 138 | Some methods from L and L. 139 | 140 | =item * 141 | 142 | Some things expected in Perl 6, such as C (C), C, and 143 | C. 144 | 145 | =item * 146 | 147 | C explicitly flattens an array. 148 | 149 | =back 150 | 151 | =head3 String Methods 152 | 153 | String methods are of the form C<< my $return = $string->method(@args) >>. 154 | Some will act on the C<$string> and some will return a new string. 155 | 156 | Many string methods are simply wrappers around core functions, but 157 | there are additional operations and modifications to core behavior. 158 | 159 | Anything which takes a regular expression, such as L and L, 160 | usually take it in the form of a compiled regex (C). Any modifiers 161 | can be attached to the C normally. Bare strings may be used in place 162 | of regular expressions, and Perl will compile it to a regex, as usual. 163 | 164 | These built in functions are implemented for scalars, they work just like normal: 165 | L, L,L 166 | L, L, L 167 | L, L, L, 168 | L, L (always in scalar 169 | context), L, 170 | L, L, L 171 | L, L, L, 172 | L, L, 173 | L, L, L. 174 | 175 | In addition, so are each of the following: 176 | 177 | =head4 concat 178 | 179 | $string1->concat($string2); 180 | 181 | Concatenates C<$string2> to C<$string1>. This 182 | corresponds to the C<.> operator used to join two strings. Returns the 183 | joined strings. 184 | 185 | =head4 strip 186 | 187 | Removes whitespace from the beginning and end of a string. 188 | 189 | " \t \n \t foo \t \n \t "->strip; # foo 190 | 191 | This is redundant and subtly different from C which allows for the 192 | removal of specific characters from the beginning and end of a string. 193 | 194 | =head4 trim 195 | 196 | Removes whitespace from the beginning and end of a string. C 197 | can also remove specific characters from the beginning and the end of 198 | string. 199 | 200 | ' hello'->trim; # 'hello' 201 | '*+* hello *+*'->trim("*+"); # ' hello ' 202 | ' *+* hello *+*'->trim("*+"); # ' *+* hello' 203 | 204 | =head4 ltrim 205 | 206 | Just like L but it only trims the left side (start) of the string. 207 | 208 | ' hello'->ltrim; # 'hello' 209 | '*+* hello *+*'->ltrim("*+"); # ' hello *+*' 210 | 211 | =head4 rtrim 212 | 213 | Just like L but it only trims the right side (end) of the string. 214 | 215 | 'hello '->rtrim; # 'hello' 216 | '*+* hello *+*'->rtrim("*+"); # '*+* hello ' 217 | 218 | =head4 split 219 | 220 | my @split_string = $string->split(qr/.../); 221 | my @split_string = $string->split(' '); 222 | 223 | A wrapper around L. It takes the regular 224 | expression as a compiled regex, or a string which Perl parses as a regex. 225 | 226 | print "10, 20, 30, 40"->split(qr{, ?})->elements, "\n"; 227 | "hi there"->split(qr/ */); # h i t h e r e 228 | 229 | The limit argument is not implemented. 230 | 231 | =head4 title_case 232 | 233 | C converts the first character of each word in the string to 234 | upper case. 235 | 236 | "this is a test"->title_case; # This Is A Test 237 | 238 | =head4 center 239 | 240 | my $centered_string = $string->center($length); 241 | my $centered_string = $string->center($length, $character); 242 | 243 | Centers $string between $character. $centered_string will be of 244 | length $length, or the length of $string, whichever is greater. 245 | 246 | C<$character> defaults to " ". 247 | 248 | say "Hello"->center(10); # " Hello "; 249 | say "Hello"->center(10, '-'); # "---Hello--"; 250 | 251 | C will never truncate C<$string>. If $length is less 252 | than C<< $string->length >> it will just return C<$string>. 253 | 254 | say "Hello"->center(4); # "Hello"; 255 | 256 | =head4 qx 257 | 258 | my $output = $string->qx; 259 | 260 | Runs $string as a command just enclosing it backticks, as in C<`$string`>. 261 | 262 | =head4 nm 263 | 264 | if( $foo->nm(qr/bar/) ) { 265 | say "$foo did not match 'bar'"; 266 | } 267 | 268 | "Negative match". Corresponds to C<< !~ >>. Otherwise works in the same 269 | way as C. 270 | 271 | =head4 m 272 | 273 | if( $foo->m(qr/bar/) ) { 274 | say "$foo matched 'bar'"; 275 | } 276 | 277 | my $matches = $foo->m( qr/(\d*) (\w+)/ ); 278 | say $matches->[0]; 279 | say $matches->[1]; 280 | 281 | Works the same as C<< m// >>, but the regex must be passed in as a C. 282 | 283 | C returns an array reference so that list functions such as C and 284 | C may be called on the result. Use C to turn this into a 285 | list of values. 286 | 287 | my ($street_number, $street_name, $apartment_number) = 288 | "1234 Robin Drive #101"->m( qr{(\d+) (.*)(?: #(\d+))?} )->elements; 289 | 290 | print "$street_number $street_name $apartment_number\n"; 291 | 292 | =head4 s 293 | 294 | my $string = "the cat sat on the mat"; 295 | $string->s( qr/cat/, "dog" ); 296 | $string->say; # the dog sat on the mat 297 | 298 | String substitution. Works similarly to C<< s/// >>. 299 | In boolean context, it returns true/false to indicate whether the substitution succeeded. C, C, C, and so on, all provide boolean context. 300 | It either fails or succeeds, having replaced only one occurrence on success -- it doesn't replace globally. 301 | In scalar context other than boolean context, it returns the modified string (incompatible change, new as of v 1.31). 302 | 303 | =head4 undef 304 | 305 | $string->undef; 306 | 307 | Assigns C to the C<$string>. 308 | 309 | =head4 defined 310 | 311 | my $is_defined = $string->defined; 312 | 313 | if( not $string->defined ) { 314 | # give $string a value... 315 | } 316 | 317 | C tests whether a value is defined (not C). 318 | 319 | =head4 repeat 320 | 321 | my $repeated_string = $string->repeat($n); 322 | 323 | Like the C operator, repeats a string C<$n> times. 324 | 325 | print 1->repeat(5); # 11111 326 | print "\n"->repeat(10); # ten newlines 327 | 328 | =head3 I/O Methods 329 | 330 | These are methods having to do with input and ouptut, not filehandles. 331 | 332 | =head4 print 333 | 334 | $string->print; 335 | 336 | Prints a string or a list of strings. Returns true if successful. 337 | 338 | =head4 say 339 | 340 | Like L, but implicitly appends a newline to the end. 341 | 342 | $string->say; 343 | 344 | =head3 Boolean Methods 345 | 346 | Methods related to boolean operations. 347 | 348 | =head4 and 349 | 350 | C corresponds to C<&&>. Returns true if both operands are true. 351 | 352 | if( $a->and($b) ) { 353 | ... 354 | } 355 | 356 | =head4 not 357 | 358 | C corresponds to C. Returns true if the subject is false. 359 | 360 | if( $a->not ) { 361 | ... 362 | } 363 | 364 | =head4 or 365 | 366 | C corresponds to C<||>. Returns true if at least one of the operands 367 | is true. 368 | 369 | if( $a->or($b) ) { 370 | ... 371 | } 372 | 373 | =head4 xor 374 | 375 | C corresponds to C. Returns true if only one of the operands is 376 | true. 377 | 378 | if( $a->xor($b) ) { 379 | ... 380 | } 381 | 382 | =head3 Number Related Methods 383 | 384 | Methods related to numbers. 385 | 386 | The basic built in functions which operate as normal : 387 | L, L, L, 388 | L, L, L, 389 | L, L, L, and 390 | L. 391 | 392 | The following operators were also included: 393 | 394 | =head4 dec 395 | 396 | $number->dec(); 397 | # $number is smaller by 1. 398 | 399 | C corresponds to C<++>. Decrements subject, will decrement character 400 | strings too: 'b' decrements to 'a'. 401 | 402 | =head4 inc 403 | 404 | C corresponds to C<++>. Increments subject, will increment character 405 | strings too. 'a' increments to 'b'. 406 | 407 | =head4 mod 408 | 409 | C corresponds to C<%>. 410 | 411 | $number->mod(5); 412 | 413 | =head4 pow 414 | 415 | C returns $number raised to the power of the $exponent. 416 | 417 | my $result = $number->pow($expontent); 418 | print 2->pow(8); # 256 419 | 420 | =head4 is_number 421 | 422 | $is_a_number = $thing->is_number; 423 | 424 | Returns true if $thing is a number as understood by Perl. 425 | 426 | 12.34->is_number; # true 427 | "12.34"->is_number; # also true 428 | 429 | =head4 is_positive 430 | 431 | $is_positive = $thing->is_positive; 432 | 433 | Returns true if $thing is a positive number. 434 | 435 | C<0> is not positive. 436 | 437 | =head4 is_negative 438 | 439 | $is_negative = $thing->is_negative; 440 | 441 | Returns true if $thing is a negative number. 442 | 443 | C<0> is not negative. 444 | 445 | =head4 is_integer 446 | 447 | $is_an_integer = $thing->is_integer; 448 | 449 | Returns true if $thing is an integer. 450 | 451 | 12->is_integer; # true 452 | 12.34->is_integer; # false 453 | 454 | =head4 is_int 455 | 456 | A synonym for is_integer. 457 | 458 | =head4 is_decimal 459 | 460 | $is_a_decimal_number = $thing->is_decimal; 461 | 462 | Returns true if $thing is a decimal number. 463 | 464 | 12->is_decimal; # false 465 | 12.34->is_decimal; # true 466 | ".34"->is_decimal; # true 467 | 468 | =head3 Reference Related Methods 469 | 470 | The following core functions are implemented. 471 | 472 | L, L, L, 473 | L. 474 | 475 | C, C, and C don't work on code references. 476 | 477 | =head3 Array Methods 478 | 479 | Array methods work on both arrays and array references: 480 | 481 | my $arr = [ 1 .. 10 ]; 482 | $arr->undef; 483 | 484 | Or: 485 | 486 | my @arr = ( 1 .. 10 ); 487 | @arr->undef; 488 | 489 | List context forces methods to return a list: 490 | 491 | my @arr = ( 1 .. 10 ); 492 | print join ' -- ', @arr->grep(sub { $_ > 3 }), "\n"; 493 | 494 | Likewise, scalar context forces methods to return an array reference. 495 | 496 | As scalar context forces methods to return a reference, methods may be chained 497 | 498 | my @arr = ( 1 .. 10 ); 499 | @arr->grep(sub { $_ > 3 })->min->say; # "4\n"; 500 | 501 | These built-in functions are defined as methods: 502 | 503 | L, L, L, 504 | L, L, 505 | L, L, 506 | L, L, L, 507 | L, L, L, 508 | L, L, and 509 | L, L. 510 | 511 | As well as: 512 | 513 | =head4 vdelete 514 | 515 | Deletes a specified value from the array. 516 | 517 | $a = 1->to(10); 518 | $a->vdelete(3); # deletes 3 519 | $a->vdelete(2)->say; # "1 4 5 6 7 8 9 10\n" 520 | 521 | =head4 uniq 522 | 523 | Removes all duplicate elements from an array and returns the new array 524 | with no duplicates. 525 | 526 | my @array = qw( 1 1 2 3 3 6 6 ); 527 | @return = @array->uniq; # @return : 1 2 3 6 528 | 529 | =head4 first 530 | 531 | Returns the first element of an array for which a callback returns true: 532 | 533 | $arr->first(sub { qr/5/ }); 534 | 535 | =head4 max 536 | 537 | Returns the largest numerical value in the array. 538 | 539 | $a = 1->to(10); 540 | $a->max; # 10 541 | 542 | =head4 min 543 | 544 | Returns the smallest numerical value in the array. 545 | 546 | $a = 1->to(10); 547 | $a->min; # 1 548 | 549 | =head4 mean 550 | 551 | Returns the mean of elements of an array. 552 | 553 | $a = 1->to(10); 554 | $a->mean; # 55/10 555 | 556 | =head4 var 557 | 558 | Returns the variance of the elements of an array. 559 | 560 | $a = 1->to(10); 561 | $a->var; # 33/4 562 | 563 | =head4 svar 564 | 565 | Returns the standard variance. 566 | 567 | $a = 1->to(10); 568 | $a->svar; # 55/6 569 | 570 | =head4 at 571 | 572 | Returns the element at a specified index. This function does not modify the 573 | original array. 574 | 575 | $a = 1->to(10); 576 | $a->at(2); # 3 577 | 578 | =head4 size, elems, length 579 | 580 | C, C and C all return the number of elements in an array. 581 | 582 | my @array = qw(foo bar baz); 583 | @array->size; # 3 584 | 585 | =head4 elements, flatten 586 | 587 | my @copy_of_array = $array->flatten; 588 | 589 | Returns the elements of an array ref as an array. 590 | This is the same as C<< @{$array} >>. 591 | 592 | Arrays can be iterated on using C and C. Both take a code 593 | reference as the body of the for statement. 594 | 595 | =head4 foreach 596 | 597 | @array->foreach(\&code); 598 | 599 | Calls C<&code> on each element of the @array in order. &code gets the 600 | element as its argument. 601 | 602 | @array->foreach(sub { print $_[0] }); # print each element of the array 603 | 604 | 605 | =head4 for 606 | 607 | @array->for(\&code); 608 | 609 | Like L, but C<&code> is called with the index, the value and 610 | the array itself. 611 | 612 | my $arr = [ 1 .. 10 ]; 613 | $arr->for(sub { 614 | my($idx, $value) = @_; 615 | print "Value #$idx is $value\n"; 616 | }); 617 | 618 | 619 | =head4 sum 620 | 621 | my $sum = @array->sum; 622 | 623 | Adds together all the elements of the array. 624 | 625 | =head4 count 626 | 627 | Returns the number of elements in array that are C to a specified value: 628 | 629 | my @array = qw/one two two three three three/; 630 | my $num = @array->count('three'); # returns 3 631 | 632 | =head4 to, upto, downto 633 | 634 | C, C, and C create array references: 635 | 636 | 1->to(5); # creates [1, 2, 3, 4, 5] 637 | 1->upto(5); # creates [1, 2, 3, 4, 5] 638 | 5->downto(5); # creates [5, 4, 3, 2, 1] 639 | 640 | Those wrap the C<..> operator. 641 | 642 | B while working with negative numbers you need to use () so as 643 | to avoid the wrong evaluation. 644 | 645 | my $range = 10->to(1); # this works 646 | my $range = -10->to(10); # wrong, interpreted as -( 10->to(10) ) 647 | my $range = (-10)->to(10); # this works 648 | 649 | =head4 head 650 | 651 | Returns the first element from C<@list>. This differs from 652 | L in that it does not change the array. 653 | 654 | my $first = @list->head; 655 | 656 | =head4 tail 657 | 658 | Returns all but the first element from C<@list>. 659 | 660 | my @list = qw(foo bar baz quux); 661 | my @rest = @list->tail; # [ 'bar', 'baz', 'quux' ] 662 | 663 | Optionally, you can pass a number as argument to ask for the last C<$n> 664 | elements: 665 | 666 | @rest = @list->tail(2); # [ 'baz', 'quux' ] 667 | 668 | =head4 slice 669 | 670 | Returns a list containing the elements from C<@list> at the indices 671 | C<@indices>. In scalar context, returns an array reference. 672 | 673 | # Return $list[1], $list[2], $list[4] and $list[8]. 674 | my @sublist = @list->slice(1,2,4,8); 675 | 676 | =head4 range 677 | 678 | C returns a list containing the elements from C<@list> with indices 679 | ranging from C<$lower_idx> to C<$upper_idx>. It returns an array reference 680 | in scalar context. 681 | 682 | my @sublist = @list->range( $lower_idx, $upper_idx ); 683 | 684 | =head4 last_index 685 | 686 | my $index = @array->last_index(qr/.../); 687 | 688 | Returns the highest index whose element matches the given regular expression. 689 | 690 | my $index = @array->last_index(\&filter); 691 | 692 | Returns the highest index for an element on which the filter returns true. 693 | The &filter is passed in each value of the @array. 694 | 695 | my @things = qw(pear poll potato tomato); 696 | my $last_p = @things->last_index(qr/^p/); # 2 697 | 698 | Called with no arguments, it corresponds to C<$#array> giving the 699 | highest index of the array. 700 | 701 | my $index = @array->last_index; 702 | 703 | =head4 first_index 704 | 705 | Works just like L but it will return the index of the I 706 | matching element. 707 | 708 | my $first_index = @array->first_index; # 0 709 | 710 | my @things = qw(pear poll potato tomato); 711 | my $last_p = @things->first_index(qr/^t/); # 3 712 | 713 | =head4 at 714 | 715 | my $value = $array->at($index); 716 | 717 | Equivalent to C<< $array->[$index] >>. 718 | 719 | =head3 Hash Methods 720 | 721 | Hash methods work on both hashes and hash references. 722 | 723 | The built in functions work as normal: 724 | 725 | L, L, L, 726 | L, L, L, 727 | L, L, L, 728 | 729 | =head4 at, get 730 | 731 | my @values = %hash->get(@keys); 732 | 733 | Returns the @values of @keys. 734 | 735 | =head4 put 736 | 737 | %hash->put(%other_hash); 738 | 739 | Overlays %other_hash on top of %hash. 740 | 741 | my $h = {a => 1, b => 2}; 742 | $h->put(b => 99, c => 3); # (a => 1, b => 99, c => 3) 743 | 744 | =head4 set 745 | 746 | Synonym for L. 747 | 748 | =head4 each 749 | 750 | Like C but for hash references. For each key in the hash, the 751 | code reference is invoked with the key and the corresponding value as 752 | arguments: 753 | 754 | my $hashref = { foo => 10, bar => 20, baz => 30, quux => 40 }; 755 | $hashref->each(sub { print $_[0], ' is ', $_[1], "\n" }); 756 | 757 | Or: 758 | 759 | my %hash = ( foo => 10, bar => 20, baz => 30, quux => 40 ); 760 | %hash->each(sub { print $_[0], ' is ', $_[1], "\n" }); 761 | 762 | Unlike regular C, this each will always iterate through the entire hash. 763 | 764 | Hash keys appear in random order that varies from run to run (this is 765 | intentional, to avoid calculated attacks designed to trigger 766 | algorithmic worst case scenario in C's hash tables). 767 | 768 | You can get a sorted C by combining C, C, and C: 769 | 770 | %hash->keys->sort->foreach(sub { 771 | print $_[0], ' is ', $hash{$_[0]}, "\n"; 772 | }); 773 | 774 | =head4 lock_keys 775 | 776 | %hash->lock_keys; 777 | 778 | Works as L. No more keys may be added to the hash. 779 | 780 | =head4 slice 781 | 782 | Takes a list of hash keys and returns the corresponding values e.g. 783 | 784 | my %hash = ( 785 | one => 'two', 786 | three => 'four', 787 | five => 'six' 788 | ); 789 | 790 | print %hash->slice(qw(one five))->join(' and '); # prints "two and six" 791 | 792 | =head4 flip 793 | 794 | Exchanges values for keys in a hash: 795 | 796 | my %things = ( foo => 1, bar => 2, baz => 5 ); 797 | my %flipped = %things->flip; # { 1 => foo, 2 => bar, 5 => baz } 798 | 799 | If there is more than one occurrence of a certain value, any one of the 800 | keys may end up as the value. This is because of the random ordering 801 | of hash keys. 802 | 803 | # Could be { 1 => foo }, { 1 => bar }, or { 1 => baz } 804 | { foo => 1, bar => 1, baz => 1 }->flip; 805 | 806 | Because references cannot usefully be keys, it will not work where the 807 | values are references. 808 | 809 | { foo => [ 'bar', 'baz' ] }->flip; # dies 810 | 811 | =head4 flatten 812 | 813 | my %hash = $hash_ref->flatten; 814 | 815 | Dereferences a hash reference. 816 | 817 | =head3 Code Methods 818 | 819 | Methods which work on code references. 820 | 821 | These are simple wrappers around the Perl core functions. 822 | L, L, 823 | 824 | Due to Perl's precedence rules, some autoboxed literals may need to be 825 | parenthesized. For instance, this works: 826 | 827 | my $curried = sub { ... }->curry(); 828 | 829 | This does not: 830 | 831 | my $curried = \&foo->curry(); 832 | 833 | The solution is to wrap the reference in parentheses: 834 | 835 | my $curried = (\&foo)->curry(); 836 | 837 | 838 | =head4 curry 839 | 840 | my $curried_code = $code->curry(5); 841 | 842 | Currying takes a code reference and provides the same code, but with 843 | the first argument filled in. 844 | 845 | my $greet_world = sub { 846 | my($greeting, $place) = @_; 847 | return "$greeting, $place!"; 848 | }; 849 | print $greet_world->("Hello", "world"); # "Hello, world!" 850 | 851 | my $howdy_world = $greet_world->curry("Howdy"); 852 | print $howdy_world->("Texas"); # "Howdy, Texas!" 853 | 854 | 855 | =head2 What's Missing? 856 | 857 | =over 4 858 | 859 | =item * 860 | 861 | File and socket operations are already implemented in an object-oriented 862 | fashion care of L, L, and L. 863 | 864 | =item * 865 | 866 | Functions listed in the L headings 867 | 868 | =over 4 869 | 870 | =item * 871 | 872 | "System V interprocess communication functions", 873 | 874 | =item * 875 | 876 | "Fetching user and group info", 877 | 878 | =item * 879 | 880 | "Fetching network info", 881 | 882 | =item * 883 | 884 | "Keywords related to perl modules", 885 | 886 | =item * 887 | 888 | "Functions for processes and process groups", 889 | 890 | =item * 891 | 892 | "Keywords related to scoping", 893 | 894 | =item * 895 | 896 | "Time-related functions", 897 | 898 | =item * 899 | 900 | "Keywords related to the control flow of your perl program", 901 | 902 | =item * 903 | 904 | "Functions for filehandles, files, or directories", 905 | 906 | =item * 907 | 908 | "Input and output functions". 909 | 910 | =back 911 | 912 | =item * 913 | 914 | (Most) binary operators 915 | 916 | =back 917 | 918 | These things are likely implemented in an object oriented fashion by other 919 | CPAN modules, are keywords and not functions, take no arguments, or don't 920 | make sense as part of the string, number, array, hash, or code API. 921 | 922 | =head2 Autoboxing 923 | 924 | I 928 | 929 | A I is an object that contains a primitive variable. Boxes are used 930 | to endow primitive types with the capabilities of objects which 931 | essential in strongly typed languages but never strictly required in Perl. 932 | Programmers might write something like C<< my $number = Int->new(5) >>. 933 | This is manual boxing. To I is to convert a simple type into an 934 | object type automatically, or only conceptually. This is done by the language. 935 | 936 | Iing makes a language look to programmers as if everything is an 937 | object while the interpreter is free to implement data storage however it 938 | pleases. Autoboxing is really making simple types such as numbers, 939 | strings, and arrays appear to be objects. 940 | 941 | C, C, C, C, and other types with lower case names, are 942 | primitives. They're fast to operate on, and require no more memory to 943 | store than the data held strictly requires. C, C, C, 944 | C, and other types with an initial capital letter, are objects. These 945 | may be subclassed (inherited from) and accept traits, among other things. 946 | These objects are provided by the system for the sole purpose of 947 | representing primitive types as objects, though this has many ancillary 948 | benefits such as making C and C work. Perl provides C to 949 | encapsulate an C, C to encapsulate a C, C to 950 | encapsulate a C, and so on. As Perl's implementations of hashes and 951 | dynamically expandable arrays store any type, not just objects, Perl 952 | programmers almost never are required to box primitive types in objects. 953 | Perl's power makes this feature less essential than it is in other 954 | languages. 955 | 956 | Iing makes primitive objects and they're boxed versions 957 | equivalent. An C may be used as an C with no constructor call, 958 | no passing, nothing. This applies to constants too, not just variables. 959 | This is a more Perl 6 way of doing things. 960 | 961 | # Perl 6 - autoboxing associates classes with primitives types: 962 | 963 | print 4.sqrt, "\n"; 964 | 965 | print [ 1 .. 20 ].elems, "\n"; 966 | 967 | The language is free to implement data storage however it wishes but the 968 | programmer sees the variables as objects. 969 | 970 | Expressions using autoboxing read somewhat like Latin suffixes. In the 971 | autoboxing mind-set, you might not say that something is "made more 972 | mnemonic", but has been "mnemonicified". 973 | 974 | Autoboxing may be mixed with normal function calls. 975 | In the case where the methods are available as functions and the functions are 976 | available as methods, it is only a matter of personal taste how the expression should be written: 977 | 978 | # Calling methods on numbers and strings, these three lines are equivalent 979 | # Perl 6 980 | 981 | print sqrt 4; 982 | print 4.sqrt; 983 | 4.sqrt.print; 984 | 985 | The first of these three equivalents assumes that a global C 986 | function exists. This first example would fail to operate if this global 987 | function were removed and only a method in the C package was left. 988 | 989 | Perl 5 had the beginnings of autoboxing with filehandles: 990 | 991 | use IO::Handle; 992 | open my $file, '<', 'file.txt' or die $!; 993 | $file->read(my $data, -s $file); 994 | 995 | Here, C is a method on a filehandle we opened but I. 996 | This lets us say things like C<< $file->print(...) >> rather than the often 997 | ambagious C<< print $file ... >>. 998 | 999 | To many people, much of the time, it makes more conceptual sense as well. 1000 | 1001 | =head3 Reasons to Box Primitive Types 1002 | 1003 | What good is all of this? 1004 | 1005 | =over 4 1006 | 1007 | =item * 1008 | 1009 | Makes conceptual sense to programmers used to object interfaces as I way 1010 | to perform options. 1011 | 1012 | =item * 1013 | 1014 | Alternative idiom. Doesn't require the programmer to write or read 1015 | expressions with complex precedence rules or strange operators. 1016 | 1017 | =item * 1018 | 1019 | Many times that parenthesis would otherwise have to span a large 1020 | expression, the expression may be rewritten such that the parenthesis span 1021 | only a few primitive types. 1022 | 1023 | =item * 1024 | 1025 | Code may often be written with fewer temporary variables. 1026 | 1027 | =item * 1028 | 1029 | Autoboxing provides the benefits of boxed types without the memory bloat of 1030 | actually using objects to represent primitives. Autoboxing "fakes it". 1031 | 1032 | =item * 1033 | 1034 | Strings, numbers, arrays, hashes, and so on, each have their own API. 1035 | Documentation for an C method for arrays doesn't have to explain 1036 | how hashes are handled and vice versa. 1037 | 1038 | =item * 1039 | 1040 | Perl tries to accommodate the notion that the "subject" of a statement 1041 | should be the first thing on the line, and autoboxing furthers this agenda. 1042 | 1043 | =back 1044 | 1045 | Perl is an idiomatic language and this is an important idiom. 1046 | 1047 | =head3 Subject First: An Aside 1048 | 1049 | Perl's design philosophy promotes the idea that the language should be 1050 | flexible enough to allow programmers to place the subject of a statement 1051 | first. For example, C<< die $! unless read $file, 60 >> looks like the 1052 | primary purpose of the statement is to C. 1053 | 1054 | While that might be the programmers primary goal, when it isn't, the 1055 | programmer can communicate his real primary intention to programmers by 1056 | reversing the order of clauses while keeping the exact same logic: C<< read 1057 | $file, 60 or die $! >>. 1058 | 1059 | Autoboxing is another way of putting the subject first. 1060 | 1061 | Nouns make good subjects, and in programming, variables, constants, and 1062 | object names are the nouns. Function and method names are verbs. C<< 1063 | $noun->verb() >> focuses the readers attention on the thing being acted on 1064 | rather than the action being performed. Compare to C<< $verb($noun) >>. 1065 | 1066 | =head3 Autoboxing and Method Results 1067 | 1068 | Let's look at some examples of ways an expression could be 1069 | written. 1070 | 1071 | # Various ways to do the same thing: 1072 | 1073 | print(reverse(sort(keys(%hash)))); # Perl 5 - pathological parenthetic 1074 | print reverse sort keys %hash; # Perl 5 - no unneeded parenthesis 1075 | 1076 | print(reverse(sort(%hash,keys)))); # Perl 6 - pathological 1077 | print reverse sort %hash.keys; # Perl 6 - no unneeded parenthesis 1078 | 1079 | %hash.keys ==> sort ==> reverse ==> print; # Perl 6 - pipeline operator 1080 | 1081 | %hash.keys.sort.reverse.print; # Perl 6 - autobox 1082 | 1083 | %hash->keys->sort->reverse->print; # Perl 5 - autobox 1084 | 1085 | This section deals with the last two of these equivalents. 1086 | These are method calls 1087 | 1088 | use autobox::Core; 1089 | use Perl6::Contexts; 1090 | 1091 | my %hash = (foo => 'bar', baz => 'quux'); 1092 | 1093 | %hash->keys->sort->reverse->print; # Perl 5 - autobox 1094 | 1095 | # prints "foo baz" 1096 | 1097 | Each method call returns an array reference, in this example. Another 1098 | method call is immediately performed on this value. This feeding of the 1099 | next method call with the result of the previous call is the common mode of 1100 | use of autoboxing. Providing no other arguments to the method calls, 1101 | however, is not common. 1102 | 1103 | C recognizes object context as provided by C<< -> >> and 1104 | coerces C<%hash> and C<@array> into references, suitable for use with 1105 | C. (Note that C also does this automatically as of 1106 | version 2.40.) 1107 | 1108 | C associates primitive types, such as references of various sorts, 1109 | with classes. C throws into those classes methods wrapping 1110 | Perl's built-in functions. In the interest of full disclosure, 1111 | C and C are my creations. 1112 | 1113 | =head3 Autobox to Simplify Expressions 1114 | 1115 | One of my pet peeves in programming is parenthesis that span large 1116 | expression. It seems like about the time I'm getting ready to close the 1117 | parenthesis I opened on the other side of the line, I realize that I've 1118 | forgotten something, and I have to arrow back over or grab the mouse. 1119 | 1120 | When the expression is too long to fit on a single line, it gets broken up, 1121 | then I must decide how to indent it if it grows to 3 or more lines. 1122 | 1123 | # Perl 5 - a somewhat complex expression 1124 | 1125 | print join("\n", map { CGI::param($_) } @cgi_vars), "\n"; 1126 | # Perl 5 - again, using autobox: 1127 | 1128 | @cgi_vars->map(sub { CGI::param($_[0]) })->join("\n")->concat("\n")->print; 1129 | 1130 | The autoboxed version isn't shorter, but it reads from left to right, and 1131 | the parenthesis from the C don't span nearly as many characters. 1132 | The complex expression serving as the value being Ced in the 1133 | non-autoboxed version becomes, in the autoboxed version, a value to call 1134 | the C method on. 1135 | 1136 | This C statement takes a list of CGI parameter names, reads the 1137 | values for each parameter, joins them together with newlines, and prints 1138 | them with a newline after the last one. 1139 | 1140 | Pretending that this expression were much larger and it had to be broken to span 1141 | several lines, or pretending that comments are to be placed after each part of 1142 | the expression, you might reformat it as such: 1143 | 1144 | @cgi_vars->map(sub { CGI::param($_[0]) }) # turn CGI arg names into values 1145 | ->join("\n") # join with newlines 1146 | ->concat("\n") # give it a trailing newline 1147 | ->print; # print them all out 1148 | 1149 | I 1150 | 1151 | 1152 | =head1 BUGS 1153 | 1154 | Yes. Report them to the author, scott@slowass.net, or post them to 1155 | GitHub's bug tracker at L. 1156 | 1157 | The API is not yet stable -- Perl 6-ish things and local extensions are 1158 | still being renamed. 1159 | 1160 | =head1 HISTORY 1161 | 1162 | See the Changes file. 1163 | 1164 | =head1 COPYRIGHT AND LICENSE 1165 | 1166 | Copyright (C) 2009, 2010, 2011 by Scott Walters and various contributors listed (and unlisted) below. 1167 | 1168 | This library is free software; you can redistribute it and/or modify 1169 | it under the same terms as Perl itself, either Perl version 5.8.9 or, 1170 | at your option, any later version of Perl 5 you may have available. 1171 | 1172 | This library is distributed in the hope that it will be useful, but without 1173 | any warranty; without even the implied warranty of merchantability or fitness 1174 | for a particular purpose. 1175 | 1176 | 1177 | =head1 SEE ALSO 1178 | 1179 | =over 1 1180 | 1181 | =item L 1182 | 1183 | =item L 1184 | 1185 | =item L 1186 | 1187 | =item L 1188 | 1189 | =item L 1190 | 1191 | =item Perl 6: L<< http://dev.perl.org/perl6/apocalypse/ >>. 1192 | 1193 | =back 1194 | 1195 | 1196 | =head1 AUTHORS 1197 | 1198 | Scott Walters, scott@slowass.net. 1199 | 1200 | Tomasz Konojacki has been assisting with maint. 1201 | 1202 | Jacinta Richardson improved documentation and tidied up the interface. 1203 | 1204 | Michael Schwern and the L contributors for tests, code, and feedback. 1205 | 1206 | JJ contributed a C method for scalars - thanks JJ! 1207 | 1208 | Ricardo SIGNES contributed patches. 1209 | 1210 | Thanks to Matt Spear, who contributed tests and definitions for numeric operations. 1211 | 1212 | Mitchell N Charity reported a bug and sent a fix. 1213 | 1214 | Thanks to chocolateboy for L and for the encouragement. 1215 | 1216 | Thanks to Bruno Vecchi for bug fixes and many, many new tests going into version 0.8. 1217 | 1218 | Thanks to L daxim/Lars DIECKOW pushing in fixes and patches from the RT queue 1219 | along with fixes to build and additional doc examples. 1220 | 1221 | Thanks to Johan Lindstrom for bug reports. 1222 | 1223 | Thanks to everyone else who sent fixes or suggestions -- apologies if I failed to include you here! 1224 | 1225 | =cut 1226 | 1227 | # 1228 | # SCALAR 1229 | # 1230 | 1231 | package autobox::Core::SCALAR; 1232 | 1233 | # Functions for SCALARs or strings 1234 | # "chomp", "chop", "chr", "crypt", "hex", "index", "lc", 1235 | # "lcfirst", "length", "oct", "ord", "pack", 1236 | # "q/STRING/", "qq/STRING/", "reverse", "rindex", 1237 | # "sprintf", "substr", "tr///", "uc", "ucfirst", "y///" 1238 | 1239 | # current doesn't handle scalar references - get can't call method chomp on unblessed reference etc when i try to support it 1240 | 1241 | sub chomp { CORE::chomp($_[0]); } 1242 | sub chop { CORE::chop($_[0]); } 1243 | sub chr { CORE::chr($_[0]); } 1244 | sub crypt { CORE::crypt($_[0], $_[1]); } 1245 | sub index { $_[2] ? CORE::index($_[0], $_[1], $_[2]) : CORE::index($_[0], $_[1]); } 1246 | sub lc { CORE::lc($_[0]); } 1247 | sub lcfirst { CORE::lcfirst($_[0]); } 1248 | sub length { CORE::length($_[0]); } 1249 | sub ord { CORE::ord($_[0]); } 1250 | sub pack { CORE::pack(shift, @_); } 1251 | sub reverse { 1252 | # Always reverse scalars as strings, never as a single element list. 1253 | return scalar CORE::reverse($_[0]); 1254 | } 1255 | 1256 | sub rindex { 1257 | return CORE::rindex($_[0], $_[1]) if @_ == 2; 1258 | return CORE::rindex($_[0], $_[1], @_[2.. $#_]); 1259 | } 1260 | 1261 | sub sprintf { CORE::sprintf($_[0], $_[1], @_[2.. $#_]); } 1262 | 1263 | sub substr { 1264 | return CORE::substr($_[0], $_[1]) if @_ == 2; 1265 | return CORE::substr($_[0], $_[1], @_[2 .. $#_]); 1266 | } 1267 | 1268 | sub uc { CORE::uc($_[0]); } 1269 | sub ucfirst { CORE::ucfirst($_[0]); } 1270 | sub unpack { CORE::unpack($_[0], @_[1..$#_]); } 1271 | sub quotemeta { CORE::quotemeta($_[0]); } 1272 | sub vec { CORE::vec($_[0], $_[1], $_[2]); } 1273 | sub undef { $_[0] = undef } 1274 | sub defined { CORE::defined($_[0]) } 1275 | sub m { my @ms = $_[0] =~ m{$_[1]} ; return @ms ? \@ms : undef } 1276 | sub nm { my @ms = $_[0] =~ m{$_[1]} ; return @ms ? undef : \@ms } 1277 | sub split { wantarray ? split $_[1], $_[0] : [ split $_[1], $_[0] ] } 1278 | sub s { 1279 | my $success = ( $_[0] =~ s{$_[1]}{$_[2]} ) ? 1 : 0; 1280 | if (Want::want('LIST')) { 1281 | Want::rreturn ($_[0]); 1282 | } elsif (Want::want('BOOL')) { # this needs to happen before the SCALAR context test 1283 | Want::rreturn $success; 1284 | } elsif (Want::want(qw'SCALAR')) { 1285 | Want::rreturn $_[0]; 1286 | } 1287 | return; # "You have to put this at the end to keep the compiler happy" from Want docs 1288 | } 1289 | 1290 | sub eval { CORE::eval "$_[0]"; } 1291 | sub system { CORE::system @_; } 1292 | sub backtick { `$_[0]`; } 1293 | sub qx { `$_[0]`; } # per #16, "backtick should probably be called qx" 1294 | 1295 | # Numeric functions 1296 | 1297 | sub abs { CORE::abs($_[0]) } 1298 | sub atan2 { CORE::atan2($_[0], $_[1]) } 1299 | sub cos { CORE::cos($_[0]) } 1300 | sub exp { CORE::exp($_[0]) } 1301 | sub int { CORE::int($_[0]) } 1302 | sub log { CORE::log($_[0]) } 1303 | sub oct { CORE::oct($_[0]) } 1304 | sub hex { CORE::hex($_[0]); } 1305 | sub sin { CORE::sin($_[0]) } 1306 | sub sqrt { CORE::sqrt($_[0]) } 1307 | 1308 | # functions for array creation 1309 | sub to { 1310 | my $res = $_[0] < $_[1] ? [$_[0]..$_[1]] : [CORE::reverse $_[1]..$_[0]]; 1311 | return wantarray ? @$res : $res 1312 | } 1313 | sub upto { 1314 | return wantarray ? ($_[0]..$_[1]) : [ $_[0]..$_[1] ] 1315 | } 1316 | sub downto { 1317 | my $res = [ CORE::reverse $_[1]..$_[0] ]; 1318 | return wantarray ? @$res : $res 1319 | } 1320 | 1321 | # Lars D didn't explain the intention of this code either in a comment or in docs and I don't see the point 1322 | #sub times { 1323 | # if ($_[1]) { 1324 | # for (0..$_[0]-1) { $_[1]->($_); }; $_[0]; 1325 | # } else { 1326 | # 0..$_[0]-1 1327 | # } 1328 | #} 1329 | 1330 | # doesn't minipulate scalars but works on scalars 1331 | 1332 | sub print { CORE::print @_; } 1333 | sub say { CORE::print @_, "\n"} 1334 | 1335 | # operators that work on scalars: 1336 | 1337 | sub concat { CORE::join '', @_; } 1338 | sub strip { 1339 | my $s = CORE::shift; 1340 | $s =~ s/^\s+//; $s =~ s/\s+$//; 1341 | return $s; 1342 | } 1343 | 1344 | # operator schizzle 1345 | sub and { $_[0] && $_[1]; } 1346 | sub dec { my $t = CORE::shift @_; --$t; } 1347 | sub inc { my $t = CORE::shift @_; ++$t; } 1348 | sub mod { $_[0] % $_[1]; } 1349 | sub neg { -$_[0]; } 1350 | sub not { !$_[0]; } 1351 | sub or { $_[0] || $_[1]; } 1352 | sub pow { $_[0] ** $_[1]; } 1353 | sub xor { $_[0] xor $_[1]; } 1354 | 1355 | # rpt should go 1356 | sub repeat { $_[0] x $_[1]; } 1357 | sub rpt { $_[0] x $_[1]; } 1358 | 1359 | # sub bless (\%$) { CORE::bless $_[0], $_[1] } # HASH, ARRAY, CODE already have a bless() and blessing a non-reference works (autobox finds the reference in the pad or stash!). "can't bless a non-referenc value" for non-reference lexical and package scalars. this would work for (\$foo)->bless but then, unlike arrays, we couldn't find the reference to the variable again later so there's not much point I can see. 1360 | 1361 | # from perl5i: 1362 | 1363 | 1364 | sub title_case { 1365 | my ($string) = @_; 1366 | $string =~ s/\b(\w)/\U$1/g; 1367 | return $string; 1368 | } 1369 | 1370 | 1371 | sub center { 1372 | my ($string, $size, $char) = @_; 1373 | Carp::carp("Use of uninitialized value for size in center()") if !defined $size; 1374 | $size = defined($size) ? $size : 0; 1375 | $char = defined($char) ? $char : ' '; 1376 | 1377 | if (CORE::length $char > 1) { 1378 | my $bad = $char; 1379 | $char = CORE::substr $char, 0, 1; 1380 | Carp::carp("'$bad' is longer than one character, using '$char' instead"); 1381 | } 1382 | 1383 | my $len = CORE::length $string; 1384 | 1385 | return $string if $size <= $len; 1386 | 1387 | my $padlen = $size - $len; 1388 | 1389 | # pad right with half the remaining characters 1390 | my $rpad = CORE::int( $padlen / 2 ); 1391 | 1392 | # bias the left padding to one more space, if $size - $len is odd 1393 | my $lpad = $padlen - $rpad; 1394 | 1395 | return $char x $lpad . $string . $char x $rpad; 1396 | } 1397 | 1398 | sub ltrim { 1399 | my ($string,$trim_charset) = @_; 1400 | $trim_charset = '\s' unless defined $trim_charset; 1401 | my $re = qr/^[$trim_charset]*/; 1402 | $string =~ s/$re//; 1403 | return $string; 1404 | } 1405 | 1406 | 1407 | sub rtrim { 1408 | my ($string,$trim_charset) = @_; 1409 | $trim_charset = '\s' unless defined $trim_charset; 1410 | my $re = qr/[$trim_charset]*$/; 1411 | $string =~ s/$re//; 1412 | return $string; 1413 | } 1414 | 1415 | 1416 | sub trim { 1417 | my $charset = $_[1]; 1418 | 1419 | return rtrim(ltrim($_[0], $charset), $charset); 1420 | } 1421 | 1422 | # POSIX is huge 1423 | #require POSIX; 1424 | #*ceil = \&POSIX::ceil; 1425 | #*floor = \&POSIX::floor; 1426 | #*round_up = \&ceil; 1427 | #*round_down = \&floor; 1428 | #sub round { 1429 | # abs($_[0] - int($_[0])) < 0.5 ? round_down($_[0]) 1430 | # : round_up($_[0]) 1431 | #} 1432 | 1433 | require Scalar::Util; 1434 | *is_number = \&Scalar::Util::looks_like_number; 1435 | sub is_positive { Scalar::Util::looks_like_number($_[0]) && $_[0] > 0 } 1436 | sub is_negative { Scalar::Util::looks_like_number($_[0]) && $_[0] < 0 } 1437 | sub is_integer { Scalar::Util::looks_like_number($_[0]) && ((CORE::int($_[0]) - $_[0]) == 0) } 1438 | *is_int = \&is_integer; 1439 | sub is_decimal { Scalar::Util::looks_like_number($_[0]) && ((CORE::int($_[0]) - $_[0]) != 0) } 1440 | 1441 | 1442 | ########################################################## 1443 | 1444 | # 1445 | # HASH 1446 | # 1447 | 1448 | package autobox::Core::HASH; 1449 | 1450 | use Carp 'croak'; 1451 | 1452 | # Functions for real %HASHes 1453 | 1454 | sub delete { 1455 | my $hash = CORE::shift; 1456 | 1457 | my @res = (); 1458 | foreach(@_) { 1459 | push @res, CORE::delete $hash->{$_}; 1460 | } 1461 | 1462 | return wantarray ? @res : \@res 1463 | } 1464 | 1465 | sub exists { 1466 | my $hash = CORE::shift; 1467 | return CORE::exists $hash->{$_[0]}; 1468 | } 1469 | 1470 | sub keys { 1471 | return wantarray ? CORE::keys %{$_[0]} : [ CORE::keys %{$_[0]} ]; 1472 | } 1473 | 1474 | sub values { 1475 | return wantarray ? CORE::values %{$_[0]} : [ CORE::values %{$_[0]} ] 1476 | } 1477 | 1478 | # local extensions 1479 | 1480 | sub get { @{$_[0]}{@_[1..$#_]}; } 1481 | *at = *get; 1482 | 1483 | sub put { 1484 | my $h = CORE::shift @_; 1485 | my %h = @_; 1486 | 1487 | while(my ($k, $v) = CORE::each %h) { 1488 | $h->{$k} = $v; 1489 | }; 1490 | 1491 | return $h; 1492 | } 1493 | 1494 | sub set { 1495 | my $h = CORE::shift @_; 1496 | my %h = @_; 1497 | while(my ($k, $v) = CORE::each %h) { 1498 | $h->{$k} = $v; 1499 | }; 1500 | 1501 | return $h; 1502 | } 1503 | 1504 | sub flatten { %{$_[0]} } 1505 | 1506 | sub each { 1507 | my $hash = CORE::shift; 1508 | my $cb = CORE::shift; 1509 | 1510 | # Reset the each iterator. (This is efficient in void context) 1511 | CORE::keys %$hash; 1512 | 1513 | while((my $k, my $v) = CORE::each(%$hash)) { 1514 | # local $_ = $v; # XXX may I break stuff? 1515 | $cb->($k, $v); 1516 | } 1517 | 1518 | return; 1519 | } 1520 | 1521 | # Keywords related to classes and object-orientedness 1522 | 1523 | sub bless { CORE::bless $_[0], $_[1] } 1524 | sub tie { CORE::tie $_[0], @_[1 .. $#_] } 1525 | sub tied { CORE::tied $_[0] } 1526 | sub ref { CORE::ref $_[0] } 1527 | 1528 | sub undef { $_[0] = {} } 1529 | 1530 | sub slice { 1531 | my ($h, @keys) = @_; 1532 | wantarray ? @{$h}{@keys} : [ @{$h}{@keys} ]; 1533 | } 1534 | 1535 | # okey, ::Util stuff should be core 1536 | 1537 | use Hash::Util; 1538 | 1539 | sub lock_keys { Hash::Util::lock_keys(%{$_[0]}); $_[0]; } 1540 | 1541 | # from perl5i 1542 | 1543 | sub flip { 1544 | croak "Can't flip hash with references as values" 1545 | if grep { CORE::ref } CORE::values %{$_[0]}; 1546 | 1547 | return wantarray ? reverse %{$_[0]} : { reverse %{$_[0]} }; 1548 | } 1549 | 1550 | # 1551 | # ARRAY 1552 | # 1553 | ############################################################################################## 1554 | package autobox::Core::ARRAY; 1555 | 1556 | use Carp 'croak'; 1557 | 1558 | # Functions for list data 1559 | 1560 | # at one moment, perl5i had this in it: 1561 | 1562 | #sub grep { 1563 | # my ( $array, $filter ) = @_; 1564 | # my @result = CORE::grep { $_ ~~ $filter } @$array; 1565 | # return wantarray ? @result : \@result; 1566 | #} 1567 | 1568 | sub grep { 1569 | my $arr = CORE::shift; 1570 | my $filter = CORE::shift; 1571 | my @result; 1572 | 1573 | if( CORE::ref $filter eq 'Regexp' ) { 1574 | @result = CORE::grep { m/$filter/ } @$arr; 1575 | } elsif( ! CORE::ref $filter ) { 1576 | @result = CORE::grep { $filter eq $_ } @$arr; # find all of the exact matches 1577 | } else { 1578 | @result = CORE::grep { $filter->($_) } @$arr; 1579 | } 1580 | 1581 | return wantarray ? @result : \@result; 1582 | } 1583 | 1584 | # last version: sub map (\@&) { my $arr = CORE::shift; my $sub = shift; [ CORE::map { $sub->($_) } @$arr ]; } 1585 | 1586 | sub map { 1587 | my( $array, $code ) = @_; 1588 | my @result = CORE::map { $code->($_) } @$array; 1589 | return wantarray ? @result : \@result; 1590 | } 1591 | 1592 | sub join { my $arr = CORE::shift; my $sep = CORE::shift; CORE::join $sep, @$arr; } 1593 | 1594 | sub reverse { my @res = CORE::reverse @{$_[0]}; wantarray ? @res : \@res; } 1595 | 1596 | sub sort { 1597 | my $arr = CORE::shift; 1598 | my $sub = CORE::shift() || sub { $a cmp $b }; 1599 | my @res = CORE::sort { $sub->($a, $b) } @$arr; 1600 | return wantarray ? @res : \@res; 1601 | } 1602 | 1603 | # functionalish stuff 1604 | 1605 | sub sum { my $arr = CORE::shift; my $res = 0; $res += $_ foreach(@$arr); $res; } 1606 | 1607 | sub mean { my $arr = CORE::shift; my $res = 0; $res += $_ foreach(@$arr); $res/@$arr; } 1608 | 1609 | sub var { 1610 | my $arr = CORE::shift; 1611 | my $mean = 0; 1612 | $mean += $_ foreach(@$arr); 1613 | $mean /= @$arr; 1614 | my $res = 0; 1615 | $res += ($_-$mean)**2 foreach (@$arr); 1616 | $res/@$arr; 1617 | } 1618 | 1619 | sub svar { 1620 | my $arr = CORE::shift; 1621 | my $mean = 0; 1622 | $mean += $_ foreach(@$arr); 1623 | $mean /= @$arr; 1624 | my $res = 0; 1625 | $res += ($_-$mean)**2 foreach (@$arr); 1626 | $res/(@$arr-1); 1627 | } 1628 | 1629 | sub max { 1630 | my $arr = CORE::shift; 1631 | my $max = $arr->[0]; 1632 | foreach (@$arr) { 1633 | $max = $_ if $_ > $max 1634 | } 1635 | 1636 | return $max; 1637 | } 1638 | 1639 | sub min { 1640 | my $arr = CORE::shift; 1641 | my $min = $arr->[0]; 1642 | foreach (@$arr) { 1643 | $min = $_ if $_ < $min 1644 | } 1645 | 1646 | return $min; 1647 | } 1648 | 1649 | # Functions for real @ARRAYs 1650 | 1651 | sub pop { CORE::pop @{$_[0]}; } 1652 | 1653 | sub push { 1654 | my $arr = CORE::shift; 1655 | CORE::push @$arr, @_; 1656 | return wantarray ? return @$arr : $arr; 1657 | } 1658 | 1659 | sub unshift { 1660 | my $a = CORE::shift; 1661 | CORE::unshift(@$a, @_); 1662 | return wantarray ? @$a : $a; 1663 | } 1664 | 1665 | sub delete { 1666 | my $arr = CORE::shift; 1667 | CORE::delete $arr->[$_[0]]; 1668 | return wantarray ? @$arr : $arr 1669 | } 1670 | 1671 | sub vdelete { 1672 | my $arr = CORE::shift; 1673 | @$arr = CORE::grep {$_ ne $_[0]} @$arr; 1674 | return wantarray ? @$arr : $arr 1675 | } 1676 | 1677 | sub shift { 1678 | my $arr = CORE::shift; 1679 | return CORE::shift @$arr; 1680 | } 1681 | 1682 | sub undef { $_[0] = [] } 1683 | 1684 | # doesn't modify array 1685 | 1686 | sub exists { 1687 | my $arr = CORE::shift; 1688 | return CORE::scalar( CORE::grep {$_ eq $_[0]} @$arr ) > 0; 1689 | } 1690 | 1691 | sub at { 1692 | my $arr = CORE::shift; 1693 | return $arr->[$_[0]]; 1694 | } 1695 | 1696 | sub count { 1697 | my $arr = CORE::shift; 1698 | return CORE::scalar(CORE::grep {$_ eq $_[0]} @$arr); 1699 | } 1700 | 1701 | sub uniq { 1702 | my $arr = CORE::shift; 1703 | 1704 | # shamelessly stolen from List::MoreUtils 1705 | # fix for code stolen from List::MoreUtils shamelessly stolen from List::MoreUtils 1706 | 1707 | my %seen = (); 1708 | my $k; 1709 | my $seen_undef; 1710 | my @res = CORE::grep { CORE::defined $_ ? not $seen{ $k = $_ }++ : CORE::not $seen_undef++ } @$arr; 1711 | return wantarray ? @res : \@res; 1712 | } 1713 | 1714 | # tied and blessed 1715 | 1716 | sub bless { CORE::bless $_[0], $_[1] } 1717 | sub tie { CORE::tie $_[0], @_[1 .. $#_] } 1718 | sub tied { CORE::tied $_[0] } 1719 | sub ref { CORE::ref $_[0] } 1720 | 1721 | # perl 6-ish extensions to Perl 5 core stuff 1722 | 1723 | # sub first(\@) { my $arr = CORE::shift; $arr->[0]; } # old, incompat version 1724 | 1725 | sub first { 1726 | # from perl5i, modified 1727 | # XXX needs test. take from perl5i? 1728 | my ( $array, $filter ) = @_; 1729 | 1730 | if ( @_ == 1 ) { 1731 | return $array->[0]; 1732 | } elsif ( CORE::ref $filter eq "Regexp" ) { 1733 | return List::Util::first( sub { $_ =~ m/$filter/ }, @$array ); 1734 | } elsif ( ! CORE::ref $filter ) { 1735 | return List::Util::first( sub { $_ eq $filter }, @$array ); 1736 | } else { 1737 | return List::Util::first( sub { $filter->() }, @$array ); 1738 | } 1739 | } 1740 | 1741 | sub size { my $arr = CORE::shift; CORE::scalar @$arr; } 1742 | sub elems { my $arr = CORE::shift; CORE::scalar @$arr; } # Larry announced it would be elems, not size 1743 | sub length { my $arr = CORE::shift; CORE::scalar @$arr; } 1744 | 1745 | # misc 1746 | 1747 | sub each { 1748 | # same as foreach(), apo12 mentions this 1749 | # XXX should we try to build a result list if we're in non-void context? 1750 | my $arr = CORE::shift; my $sub = CORE::shift; 1751 | foreach my $i (@$arr) { 1752 | # local $_ = $i; # XXX may I break stuff? 1753 | $sub->($i); 1754 | } 1755 | } 1756 | 1757 | sub foreach { 1758 | my $arr = CORE::shift; my $sub = CORE::shift; 1759 | foreach my $i (@$arr) { 1760 | # local $_ = $i; # XXX may I break stuff? 1761 | $sub->($i); 1762 | } 1763 | } 1764 | 1765 | sub for { 1766 | my $arr = CORE::shift; my $sub = CORE::shift; 1767 | for(my $i = 0; $i <= $#$arr; $i++) { 1768 | # local $_ = $arr->[$i]; # XXX may I break stuff? 1769 | $sub->($i, $arr->[$i], $arr); 1770 | } 1771 | } 1772 | 1773 | sub print { my $arr = CORE::shift; my @arr = @$arr; CORE::print "@arr"; } 1774 | sub say { my $arr = CORE::shift; my @arr = @$arr; CORE::print "@arr\n"; } 1775 | 1776 | # local 1777 | 1778 | sub elements { ( @{$_[0]} ) } 1779 | sub flatten { ( @{$_[0]} ) } 1780 | 1781 | sub head { 1782 | return $_[0]->[0]; 1783 | } 1784 | 1785 | sub slice { 1786 | my $list = CORE::shift; 1787 | # the rest of the arguments in @_ are the indices to take 1788 | 1789 | return wantarray ? @$list[@_] : [@{$list}[@_]]; 1790 | } 1791 | 1792 | sub range { 1793 | my ($array, $lower, $upper) = @_; 1794 | 1795 | my @slice = @{$array}[$lower .. $upper]; 1796 | 1797 | return wantarray ? @slice : \@slice; 1798 | 1799 | } 1800 | 1801 | sub tail { 1802 | my $last = $#{$_[0]}; 1803 | 1804 | my $first = defined $_[1] ? $last - $_[1] + 1 : 1; 1805 | 1806 | Carp::croak("Not enough elements in array") if $first < 0; 1807 | 1808 | # Yeah... avert your eyes 1809 | return wantarray ? @{$_[0]}[$first .. $last] : [@{$_[0]}[$first .. $last]]; 1810 | } 1811 | 1812 | sub first_index { 1813 | if (@_ == 1) { 1814 | return 0; 1815 | } 1816 | else { 1817 | my ($array, $arg) = @_; 1818 | 1819 | my $filter = CORE::ref($arg) eq 'Regexp' ? sub { $_[0] =~ $arg } : $arg; 1820 | 1821 | foreach my $i (0 .. $#$array) { 1822 | return $i if $filter->($array->[$i]); 1823 | } 1824 | 1825 | return 1826 | } 1827 | } 1828 | 1829 | sub last_index { 1830 | if (@_ == 1) { 1831 | return $#{$_[0]}; 1832 | } 1833 | else { 1834 | my ($array, $arg) = @_; 1835 | 1836 | my $filter = CORE::ref($arg) eq 'Regexp' ? sub { $_[0] =~ $arg } : $arg; 1837 | 1838 | foreach my $i (CORE::reverse 0 .. $#$array ) { 1839 | return $i if $filter->($array->[$i]); 1840 | } 1841 | 1842 | return 1843 | } 1844 | } 1845 | 1846 | ############################################################################################## 1847 | 1848 | # 1849 | # CODE 1850 | # 1851 | 1852 | package autobox::Core::CODE; 1853 | 1854 | sub bless { CORE::bless $_[0], $_[1] } 1855 | sub ref { CORE::ref $_[0] } 1856 | 1857 | # perl 6-isms 1858 | 1859 | sub curry { my $code = CORE::shift; my @args = @_; sub { CORE::unshift @_, @args; goto &$code; }; } 1860 | 1861 | 1; 1862 | 1863 | -------------------------------------------------------------------------------- /t/added.t: -------------------------------------------------------------------------------- 1 | use Test::More 'no_plan'; 2 | use autobox::Core; 3 | 4 | ##################################################################### 5 | # Load 6 | ##################################################################### 7 | ok(1); 8 | 9 | ##################################################################### 10 | # Scalar 11 | ##################################################################### 12 | ok(1->and(5)); 13 | ok(!1->and(0)); 14 | 15 | ok(1->dec == 0); 16 | 17 | ok(1->inc == 2); 18 | 19 | ok(5->mod(2) == 1); 20 | 21 | ok(1->neg == -1); 22 | 23 | ok(not 1->not); 24 | 25 | ok(1->or(5)); 26 | 27 | ok(2->pow(5) == 32); 28 | 29 | ok(1->rpt(5) eq '11111'); 30 | 31 | ok(1->xor(5) == 0); 32 | 33 | ok("1+5"->eval() == 6); 34 | 35 | ok("echo test"->backtick =~ "test"); 36 | ok("echo test"->qx =~ "test"); # qx as an alias to backtick per #16 37 | 38 | my $a = 1->to(10); 39 | ok($a->[0] == 1 && $a->[@$a-1] == 10); 40 | $a = 10->to(1); 41 | ok($a->[0] == 10 && $a->[@$a-1] == 1); 42 | my @a = 1->to(10); 43 | is_deeply \@a, [ 1 .. 10 ]; 44 | 45 | $a = 1->upto(10); 46 | ok($a->[0] == 1 && $a->[@$a-1] == 10); 47 | 48 | @a = 1->upto(10); 49 | is_deeply \@a, [ 1 .. 10 ]; 50 | 51 | $a = 10->downto(1); 52 | ok($a->[0] == 10 && $a->[@$a-1] == 1); 53 | 54 | @a = 10->downto(1); 55 | is_deeply \@a, [ reverse 1 .. 10 ]; 56 | 57 | ##################################################################### 58 | # Hashes 59 | ##################################################################### 60 | my $h = {a => 1, b => 2, c => 3}; 61 | is($h->at('b'), 2); 62 | 63 | is($h->get('c'), 3); 64 | 65 | $h->put('d' => 4, e=>5, f=>6); 66 | is($h->get('e'), 5); 67 | $h->put('g', 7); 68 | is($h->get('g'), 7); 69 | 70 | $h->set('h' => 8); 71 | is($h->get('h'), 8); 72 | $h->set('i', 9); 73 | is($h->get('i'), 9); 74 | 75 | is_deeply [$h->get(qw(a b c))], [1, 2, 3]; 76 | 77 | is_deeply( 78 | [ sort $h->flatten ], 79 | [ sort %$h ], 80 | "flattening gets us all the contents", 81 | ); 82 | 83 | ##################################################################### 84 | # Array 85 | ##################################################################### 86 | $a = 1->to(10); 87 | ok($a->sum == 55); 88 | ok($a->[0] == 1); 89 | 90 | ok($a->mean == 55/10); 91 | 92 | ok($a->var == 33/4); 93 | 94 | ok($a->svar == 55/6); 95 | 96 | ok($a->max == 10); 97 | 98 | ok($a->min == 1); 99 | 100 | ok($a->exists(5)); 101 | ok(not $a->exists(11)); 102 | 103 | $a = $a->map(sub {int($_/2)}); 104 | ok($a->exists(3)); 105 | $a->vdelete(3); 106 | ok(not $a->exists(3)); 107 | 108 | ok($a->at(0) == 0); 109 | 110 | ok($a->count(4) == 2); 111 | 112 | $a = $a->uniq; 113 | ok($a->count(1) == 1 && $a->count(4) == 1); 114 | 115 | ok($a->first == 0); 116 | ok($a->first(sub { m/4/ }) == 4); 117 | ok($a->first(qr/4/) == 4); 118 | 119 | $a = 1->to(10); 120 | $a->unshift(100); 121 | ok($a->sum == 155); 122 | 123 | 124 | 125 | 126 | 127 | -------------------------------------------------------------------------------- /t/array-slice.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 5; 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar baz); 8 | 9 | ok @array->slice(0); 10 | is_deeply [@array->slice(0)], ['foo']; 11 | is_deeply [@array->slice(0,2)], ['foo', 'baz']; 12 | 13 | my @slice = @array->slice(0,1); 14 | 15 | is scalar @slice, 2, "Returns an array in list context"; 16 | 17 | my $slice = @array->slice(0,1); 18 | 19 | is ref $slice, 'ARRAY', "Returns an arrayref in scalar context"; 20 | -------------------------------------------------------------------------------- /t/bless.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my %struct = ( 8 | ARRAY => [ 'foo' ], 9 | HASH => { 'foo' => 1 }, 10 | CODE => sub { 'foo' }, 11 | ); 12 | 13 | foreach my $reftype ( keys %struct ) { 14 | $struct{$reftype}->bless("Object"); 15 | is ref $struct{$reftype}, "Object"; 16 | } 17 | 18 | TODO: { 19 | todo_skip "Make it work for Regexp, Scalar and Glob", 3; 20 | my %todo = ( 21 | Regexp => qr/foo/, 22 | SCALAR => \'foo', 23 | GLOB => \*STDIN, 24 | ); 25 | 26 | foreach my $reftype ( keys %todo ) { 27 | $todo{$reftype}->bless("Object"); 28 | is ref $todo{$reftype}, "Object"; 29 | } 30 | } 31 | 32 | -------------------------------------------------------------------------------- /t/center.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use autobox::Core; 4 | 5 | use Test::More tests => 25; 6 | 7 | my $hello = 'hello'; 8 | 9 | is( $hello->center(7), ' hello ', 10 | '->center() with even length has equal whitespace on both sides' ); 11 | is( $hello->center(7,'-'), '-hello-', 12 | '->center() with even length has equal whitespace on both sides' ); 13 | 14 | is( $hello->center(8), ' hello ', 15 | '->center() with odd length pads left' ); 16 | 17 | is( $hello->center(4), 'hello', 18 | '->center() with too-short length returns the string unmodified' ); 19 | 20 | is( $hello->center(0), 'hello', 21 | '->center(0)' ); 22 | 23 | is( $hello->center(-1), 'hello', 24 | '->center(-1)' ); 25 | 26 | is( "even"->center(6, "-"), '-even-', 27 | '->center(6, "-")' ); 28 | 29 | is( "even"->center(7, "-"), '--even-', 30 | '->center(7, "-")' ); 31 | 32 | is( "even"->center(0, "-"), 'even', 33 | '->center(0, "-")' ); 34 | 35 | # Test that center() always returns the correct length 36 | for my $size ($hello->length..20) { 37 | is( $hello->center($size)->length, $size, "center($size) returns that size" ); 38 | } 39 | -------------------------------------------------------------------------------- /t/chomp.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | 3 | use autobox::Core; 4 | 5 | my $line = "This has a new line\n"; 6 | 7 | $line->chomp; 8 | 9 | is $line, "This has a new line"; 10 | 11 | -------------------------------------------------------------------------------- /t/chop.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my $string = "This is a string"; 8 | 9 | my $char = $string->chop; 10 | 11 | is $string, "This is a strin", "Chop modifies the string"; 12 | is $char, "g", "... and returns the last character"; 13 | 14 | TODO: { 15 | 16 | todo_skip "Chop should work on lists too", 2; 17 | 18 | my @list = qw(foo bar baz); 19 | 20 | my $char = @list->chop; 21 | 22 | is $char, 'z'; 23 | 24 | is_deeply \@list, [ 'fo', 'ba', 'ba' ]; 25 | } 26 | 27 | -------------------------------------------------------------------------------- /t/chr.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | is 65->chr, chr(65); 8 | -------------------------------------------------------------------------------- /t/concat.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | use autobox::Core; 5 | 6 | is 'foo'->concat(qw(bar quux)), 'foobarquux'; 7 | -------------------------------------------------------------------------------- /t/crypt.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | use autobox::Core; 5 | 6 | use Config; 7 | SKIP: { 8 | skip("crypt not defined on this system", 1) unless $Config{d_crypt}; 9 | skip("crypt redefined to use a different algorithm", 1) if $Config{osname} eq 'openbsd'; 10 | is 'PLAINTEXT'->crypt('SALT'), 'SAPH9ylAEPe62'; 11 | } 12 | -------------------------------------------------------------------------------- /t/curry.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | 8 | my $times = sub { $_[0] * $_[1] }; 9 | 10 | my $times_two = $times->curry(2); 11 | my $times_four = $times->curry(4); 12 | 13 | is $times_two->(5), 10; 14 | is $times_four->(5), 20; 15 | -------------------------------------------------------------------------------- /t/each.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my %hash = ( foo => 1, bar => 2, baz => 3 ); 8 | 9 | my @glued; 10 | %hash->each( sub { push @glued, $_[0] . $_[1] } ); 11 | 12 | is_deeply [ sort @glued ], [ qw(bar2 baz3 foo1) ]; 13 | 14 | my @array = values %hash; 15 | 16 | my @added; 17 | @array->each( sub { push @added, $_[0] + 1 } ); 18 | 19 | is_deeply [ sort @added ], [ qw(2 3 4) ]; 20 | 21 | # Ensure each() always iterates through the whole hash 22 | { 23 | my %want = (foo => 23, bar => 42, baz => 99, biff => 66); 24 | 25 | # Call each once on %want to start the iterator attached to %want 26 | my($k,$v) = each %want; 27 | 28 | my %have; 29 | %want->each( sub { $have{$_[0]} = $_[1] } ); 30 | 31 | is_deeply \%have, \%want; 32 | } 33 | -------------------------------------------------------------------------------- /t/elements.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar baz); 8 | 9 | my @returned = @array->elements; 10 | 11 | is_deeply \@returned, \@array; 12 | 13 | my $count = @array->elements; 14 | 15 | is $count, 3; 16 | 17 | -------------------------------------------------------------------------------- /t/elems.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar baz); 8 | 9 | is @array->elems, 3; 10 | -------------------------------------------------------------------------------- /t/first_index.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use autobox::Core; 4 | use Test::More tests => 3; 5 | 6 | my @numbers = ( 1 .. 10 ); 7 | 8 | is( @numbers->first_index, 0 ); 9 | is( @numbers->first_index( sub { $_[0] > 9 } ), 9 ); 10 | 11 | is( @numbers->first_index( qr/^2/ ), 1 ); 12 | -------------------------------------------------------------------------------- /t/flatten.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar baz); 8 | 9 | my @returned = @array->flatten; 10 | 11 | is_deeply \@returned, \@array; 12 | 13 | my $count = @array->flatten; 14 | 15 | is $count, 3; 16 | -------------------------------------------------------------------------------- /t/flip.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use Test::More tests => 2; 3 | use autobox::Core; 4 | 5 | my %hash = ( 1 => 'foo', 3 => 'bar' ); 6 | my $f; 7 | 8 | is_deeply( $f = %hash->flip, { foo => 1, bar => 3 } ); 9 | 10 | my %f = %hash->flip; 11 | 12 | is_deeply( \%f, { foo => 1, bar => 3 }, "Returns hash in list context" ); 13 | 14 | my %nested = ( 1 => { foo => 'bar' }, 2 => 'bar' ); 15 | -------------------------------------------------------------------------------- /t/for.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my @array = qw(1 2 3); 8 | 9 | my @added; 10 | @array->for( sub { my ($i, $v, $arr) = @_; push @added, $i + $v + @$arr } ); 11 | 12 | is_deeply [ @added ], [ qw(4 6 8) ]; 13 | -------------------------------------------------------------------------------- /t/foreach.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my @array = qw(1 2 3); 8 | 9 | my @added; 10 | @array->foreach( sub { push @added, $_[0] + 1 } ); 11 | 12 | is_deeply [ sort @added ], [ qw(2 3 4) ]; 13 | -------------------------------------------------------------------------------- /t/grep.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use Test::More 'no_plan'; 4 | use strict; 5 | use warnings; 6 | 7 | use autobox::Core; 8 | 9 | my @array = qw(1 2 3); 10 | 11 | my @odd = @array->grep(sub { $_ % 2 }); 12 | 13 | is_deeply \@odd, [qw(1 3)], "Expected coderef grep results"; 14 | 15 | my $arrayref = @array->grep( sub { 'foo' } ); 16 | 17 | is ref $arrayref, 'ARRAY', "Returns arrayref in scalar context"; 18 | 19 | @array = qw( foo bar baz ); 20 | my $d; 21 | 22 | ok ( eval { @array->grep( sub { 42 } || 1) }, "Should accept code refs" ); 23 | ok ( eval { @array->grep( qr/foo/ ) || 1 }, "Should accept Regexps" ); 24 | 25 | is_deeply( $d = @array->grep('foo'), [qw( foo )], "Works with SCALAR" ); 26 | is_deeply( $d = @array->grep('zar'), [], "Works with SCALAR" ); 27 | is_deeply( $d = @array->grep(qr/^ba/), [qw( bar baz )], "Works with Regexp" ); 28 | is_deeply( $d = @array->grep(sub { /^ba/ }), [qw( bar baz )], "... as with Code refs" ); 29 | 30 | # context 31 | my @d = @array->grep(qr/^ba/); 32 | 33 | is scalar @d, 2, "Returns an array in list context"; 34 | -------------------------------------------------------------------------------- /t/head.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 2; 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar baz); 8 | 9 | ok @array->head; 10 | is @array->head, 'foo'; 11 | -------------------------------------------------------------------------------- /t/index.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | use autobox::Core; 5 | 6 | my $string = "I like pie"; 7 | my $substr = "pie"; 8 | 9 | is $string->index($substr), 7; 10 | is $string->index($substr, 8), -1; 11 | 12 | -------------------------------------------------------------------------------- /t/join.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my @list = qw(h i t h e r e); 8 | 9 | is @list->join(''), 'hithere'; 10 | is @list->join(' '), 'h i t h e r e'; 11 | -------------------------------------------------------------------------------- /t/keys.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my %hash = ( foo => 1, bar => 2, baz => 3 ); 8 | 9 | is_deeply [ sort %hash->keys ], [ qw( bar baz foo ) ]; 10 | 11 | my $arrayref = %hash->keys; 12 | 13 | is ref $arrayref, 'ARRAY', "Returns arrayref in scalar context"; 14 | -------------------------------------------------------------------------------- /t/last_index.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use autobox::Core; 4 | use Test::More tests => 3; 5 | 6 | my @numbers = ( 1 .. 10 ); 7 | 8 | is( @numbers->last_index, 9 ); 9 | is( @numbers->last_index( sub { $_[0] > 2 } ), 9 ); 10 | 11 | is( @numbers->last_index( qr/^1/ ), 9 ); 12 | -------------------------------------------------------------------------------- /t/lc.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my $string = "THIS IS A STRING"; 8 | 9 | is $string->lc, "this is a string"; 10 | -------------------------------------------------------------------------------- /t/lcfirst.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my $string = "THIS IS A STRING"; 8 | 9 | is $string->lcfirst, 'tHIS IS A STRING'; 10 | 11 | -------------------------------------------------------------------------------- /t/length.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my $string = "THIS IS A STRING"; 8 | 9 | is $string->length, 16; 10 | 11 | my @array = qw(foo bar baz); 12 | 13 | is @array->length, 3; 14 | 15 | -------------------------------------------------------------------------------- /t/m.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | use autobox::Core; 5 | 6 | ok 'foo'->m(qr/o+/); 7 | ok ! 'foo'->m(qr/x+/); 8 | -------------------------------------------------------------------------------- /t/map.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | 8 | { 9 | my @array = qw(1 2 3); 10 | 11 | my @added = @array->map(sub { ++$_ }); 12 | 13 | is_deeply \@added, [qw(2 3 4)]; 14 | 15 | my $arrayref = @array->map( sub { 'foo' } ); 16 | 17 | is ref $arrayref, 'ARRAY', "Returns arrayref in scalar context"; 18 | } 19 | 20 | done_testing; 21 | -------------------------------------------------------------------------------- /t/nm.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | use autobox::Core; 5 | 6 | ok 'bar'->nm(qr/o+/); 7 | ok ! 'bar'->nm(qr/bar/); 8 | -------------------------------------------------------------------------------- /t/number.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use Test::More tests => 49; 4 | use autobox::Core; 5 | 6 | #is( 12.34->ceil, 13); 7 | #is( 12.34->round_up, 13); 8 | #is( 12.34->floor, 12); 9 | #is( 12.34->round_down, 12); 10 | is( 12.34->int, 12); 11 | 12 | #is( 2.5->round, 3 ); 13 | #is( 2->round, 2 ); 14 | #is( 0->round, 0 ); 15 | #is( 2.51->round, 3 ); 16 | #is( -3.51->round, -4 ); 17 | 18 | ok( 12->is_number ); 19 | ok(!'FF'->is_number ); 20 | 21 | ok( 12->is_positive ); 22 | ok( "+12"->is_positive ); 23 | ok( 12.34->is_positive ); 24 | ok( !"foo"->is_positive ); 25 | ok( !"-12.2"->is_positive ); 26 | 27 | ok( !12->is_negative ); 28 | ok( "-12"->is_negative ); 29 | ok( (-12.34)->is_negative ); 30 | ok( !"foo"->is_negative ); 31 | ok( "-12.2"->is_negative ); 32 | 33 | ok !0->is_negative, "zero is not negative"; 34 | ok !0->is_positive, "zero is not positive"; 35 | 36 | ok( 12->is_integer ); 37 | ok( -12->is_integer ); 38 | ok( "+12"->is_integer ); 39 | ok(!12.34->is_integer ); 40 | 41 | ok( 12->is_int ); 42 | ok(!12.34->is_int ); 43 | 44 | ok( 12.34->is_decimal ); 45 | ok( ".34"->is_decimal ); 46 | ok( !12->is_decimal ); 47 | ok(!'abc'->is_decimal ); 48 | 49 | is( '123'->reverse, '321' ); 50 | 51 | TODO: { 52 | local $TODO = q{ hex is weird }; 53 | 54 | is( 255->hex, 'FF'); 55 | is( 'FF'->dec, 255); 56 | is( 0xFF->dec, 255); 57 | 58 | }; 59 | 60 | TODO: { 61 | todo_skip "Make number methods work on non-scalar refs", 20; 62 | 63 | for my $ref ([ 'foo' ], { bar => 1 }, \'baz', sub { 'gorch' }) { 64 | for my $method (qw(is_decimal is_integer is_int is_negative is_positive)) { 65 | ok(!$ref->$method); 66 | } 67 | } 68 | } 69 | -------------------------------------------------------------------------------- /t/numeric.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my $num = 0.5; 8 | my $e = 1E-10; 9 | 10 | cmp_ok( abs($num->abs - abs($num)), '<', $e ); 11 | cmp_ok( abs($num->cos - cos($num)), '<', $e ); 12 | cmp_ok( abs($num->exp - exp($num)), '<', $e ); 13 | cmp_ok( abs($num->int - int($num)), '<', $e ); 14 | cmp_ok( abs($num->log - log($num)), '<', $e ); 15 | cmp_ok( abs($num->oct - oct($num)), '<', $e ); 16 | cmp_ok( abs(05->hex - hex(05)), '<', $e ); 17 | cmp_ok( abs($num->sin - sin($num)), '<', $e ); 18 | cmp_ok( abs($num->sqrt - sqrt($num)), '<', $e ); 19 | 20 | cmp_ok( abs($num->atan2($num) - atan2($num, $num)), '<', $e ); 21 | -------------------------------------------------------------------------------- /t/ord.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | is 'A'->ord, ord('A'); 8 | -------------------------------------------------------------------------------- /t/pack.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | SKIP: { 8 | # XXX this and pack.t could use a counterpart that works on 5.8 but this is so utterly non-urgent -- sdw 9 | skip "Only for 5.10", 1, if $] < 5.010; 10 | is 'nN'->pack(42, 4711), pack('nN', 42, 4711); 11 | is '(sl)<'->pack(-42, 4711), pack('(sl)<', -42, 4711); 12 | }; 13 | 14 | ok(1); 15 | -------------------------------------------------------------------------------- /t/pop.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar); 8 | 9 | is @array->pop, 'bar'; 10 | 11 | is_deeply \@array, [qw(foo)]; 12 | -------------------------------------------------------------------------------- /t/print.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my $message = "This is an important message"; 8 | my @array = qw(this is an important message); 9 | 10 | SKIP: { 11 | my $has_test_output = eval { require Test::Output }; 12 | 13 | skip "Don't have Test::Output", 2, if not $has_test_output; 14 | Test::Output::stdout_is( sub { $message->print }, $message ); 15 | Test::Output::stdout_is( sub { @array->print }, "@array" ); 16 | } 17 | 18 | # We need at least one test so that Test::Harness doesn't complain in 19 | # case we had to skip above 20 | 21 | ok 1; 22 | 23 | -------------------------------------------------------------------------------- /t/push.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar); 8 | 9 | my @returned = @array->push('baz'); 10 | 11 | is_deeply \@array, [qw(foo bar baz)]; 12 | is_deeply \@returned, [qw(foo bar baz)]; 13 | 14 | my $arrayref = @array->push('baz'); 15 | 16 | is ref $arrayref, 'ARRAY', "Returns arrayref in scalar context"; 17 | my $array = [qw(foo bar)]; 18 | 19 | $array->push('baz'); 20 | 21 | is_deeply $array, [qw(foo bar baz)]; 22 | 23 | -------------------------------------------------------------------------------- /t/quotemeta.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | use autobox::Core; 5 | 6 | is 'so (many [pairs])'->quotemeta, 'so\ \(many\ \[pairs\]\)'; 7 | -------------------------------------------------------------------------------- /t/range.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 4; 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar baz gorch); 8 | 9 | ok @array->range(0,1); 10 | is_deeply [@array->range(0,1)], ['foo', 'bar']; 11 | 12 | my @slice = @array->range(0,2); 13 | 14 | is scalar @slice, 3, "Returns an array in list context"; 15 | 16 | my $slice = @array->range(0,2); 17 | 18 | is ref $slice, 'ARRAY', "Returns an arrayref in scalar context"; 19 | -------------------------------------------------------------------------------- /t/ref.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my %struct = ( 8 | ARRAY => [ 'foo' ], 9 | HASH => { 'foo' => 1 }, 10 | CODE => sub { 'foo' }, 11 | ); 12 | 13 | foreach my $reftype ( keys %struct ) { 14 | is $struct{$reftype}->ref, $reftype; 15 | } 16 | 17 | TODO: { 18 | todo_skip "Make it work for Regexp, Scalar and Glob", 3; 19 | my %todo = ( 20 | Regexp => qr/foo/, 21 | SCALAR => \'foo', 22 | GLOB => \*STDIN, 23 | ); 24 | 25 | foreach my $reftype ( keys %todo ) { 26 | is $todo{$reftype}->ref, $reftype; 27 | } 28 | } 29 | 30 | -------------------------------------------------------------------------------- /t/reverse.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | # https://github.com/schwern/perl5i/issues/182 8 | my $scalar = 'foo'; 9 | my($reverse) = $scalar->reverse; # list context 10 | is $reverse, 'oof', 'reverse in list context reverses the scalar'; 11 | is scalar $scalar->reverse, 'oof', 'reverse in scalar context reverses the scalar'; 12 | 13 | is "Hello"->reverse, "olleH"; 14 | 15 | my @list = qw(foo bar baz); 16 | 17 | is_deeply [@list->reverse], [qw(baz bar foo)]; 18 | 19 | my $arrayref = @list->reverse; 20 | 21 | is ref $arrayref, "ARRAY", "returns an arrayref in scalar context"; 22 | 23 | -------------------------------------------------------------------------------- /t/rindex.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | use autobox::Core; 5 | 6 | my $string = "I like pie pie"; 7 | my $substr = "pie"; 8 | 9 | is $string->rindex($substr), rindex($string, $substr); 10 | is $string->rindex($substr, 12), rindex($string, $substr, 12); 11 | 12 | -------------------------------------------------------------------------------- /t/s.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my $string = 'HELLO'; 8 | $string->s('^HE', 'Hu'); 9 | 10 | is $string, 'HuLLO'; 11 | 12 | ok $string->s(qr/LO/, '10') eq 'HuL10'; # using ok() instead of is() to test Want picking up on scalar context 13 | 14 | ok ! $string->s(qr/LO/, '10'); # testing Want picking up on boolean context 15 | ok ! ! $string->s(qr/10/, 'lo'); # testing Want picking up on boolean context 16 | 17 | -------------------------------------------------------------------------------- /t/say.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my $message = "This is an important message"; 8 | my @array = qw(this is an important message); 9 | 10 | SKIP: { 11 | my $has_test_output = eval { require Test::Output }; 12 | 13 | skip "Don't have Test::Output", 1, if not $has_test_output; 14 | Test::Output::stdout_is( sub { $message->say }, $message . "\n" ); 15 | Test::Output::stdout_is( sub { @array->say }, "@array\n" ); 16 | } 17 | 18 | # We need at least one test so that Test::Harness doesn't complain in 19 | # case we had to skip above 20 | 21 | ok 1; 22 | 23 | -------------------------------------------------------------------------------- /t/scalar.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use Test::More 'no_plan'; 4 | use autobox::Core; 5 | 6 | is( "this is a test"->title_case, 'This Is A Test'); 7 | is( "this is a test"->lc->title_case, 'This Is A Test'); 8 | 9 | is( "thIS is a teST"->title_case, 'ThIS Is A TeST'); 10 | is( "thIS is a teST"->lc->title_case, 'This Is A Test'); 11 | 12 | is( ' testme'->ltrim, 'testme' ); 13 | is( ' testme'->rtrim, ' testme' ); 14 | is( ' testme'->trim, 'testme' ); 15 | 16 | is( 'testme '->ltrim, 'testme ' ); 17 | is( 'testme '->rtrim, 'testme' ); 18 | is( 'testme '->trim, 'testme' ); 19 | 20 | is( ' testme '->ltrim, 'testme ' ); 21 | is( ' testme '->rtrim, ' testme' ); 22 | is( ' testme '->trim, 'testme' ); 23 | 24 | is( '--> testme <--'->ltrim("-><"), ' testme <--' ); 25 | is( '--> testme <--'->rtrim("-><"), '--> testme ' ); 26 | is( '--> testme <--'->trim("-><"), ' testme ' ); 27 | 28 | is( ' --> testme <--'->trim("-><"), ' --> testme ' ); 29 | -------------------------------------------------------------------------------- /t/shift.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar); 8 | 9 | is @array->shift, 'foo'; 10 | 11 | is_deeply \@array, [qw(bar)]; 12 | -------------------------------------------------------------------------------- /t/size.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar baz); 8 | 9 | is @array->size, 3; 10 | -------------------------------------------------------------------------------- /t/slice.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | use autobox::Core; 5 | 6 | my $h = {a => 1, b => 2, c => 3}; 7 | my %h = %$h; 8 | 9 | my @slice = $h->slice(qw(a c)); 10 | is_deeply(\@slice, [ 1, 3 ]); 11 | my $slice = $h->slice(qw(b c)); 12 | is_deeply($slice, [ 2, 3 ]); 13 | @slice = %h->slice(qw(a c)); 14 | is_deeply(\@slice, [ 1, 3 ]); 15 | $slice = %h->slice(qw(b c)); 16 | is_deeply($slice, [ 2, 3 ]); 17 | 18 | -------------------------------------------------------------------------------- /t/sort.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar baz); 8 | 9 | my @returned = @array->sort; 10 | 11 | is_deeply \@returned, [qw(bar baz foo)]; 12 | 13 | @returned = @array->sort(sub { $_[1] cmp $_[0] }); 14 | 15 | is_deeply \@returned, [qw(foo baz bar)]; 16 | 17 | my $arrayref = @array->sort; 18 | 19 | is ref $arrayref, "ARRAY", "Returns an arrayref in scalar context"; 20 | -------------------------------------------------------------------------------- /t/split.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | is_deeply ["hi there"->split(qr/ */)], [qw(h i t h e r e)]; 8 | 9 | my $arrayref = "hi there"->split(qr/ */); 10 | 11 | is ref $arrayref, 'ARRAY', "Returns arrayref in scalar context"; 12 | 13 | -------------------------------------------------------------------------------- /t/sprintf.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my $format = "%.2f"; 8 | 9 | is $format->sprintf(2/3), "0.67"; 10 | -------------------------------------------------------------------------------- /t/strip.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | use autobox::Core; 5 | 6 | is " \t \n \t foo \t \n \t "->strip, 'foo'; 7 | -------------------------------------------------------------------------------- /t/substr.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | use autobox::Core; 5 | 6 | my $s = "The black cat climbed the green tree"; 7 | my $color = $s->substr(4, 5); 8 | 9 | is $color, 'black'; 10 | 11 | my $middle = $s->substr(4, -11); 12 | 13 | is $middle, 'black cat climbed the'; 14 | 15 | my $end = $s->substr(14); 16 | is $end, 'climbed the green tree'; 17 | 18 | my $tail = $s->substr(-4); 19 | is $tail, 'tree'; 20 | 21 | my $z = $s->substr(-4, 2); 22 | 23 | is $z, 'tr'; 24 | 25 | -------------------------------------------------------------------------------- /t/synopsis.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 7; 4 | use autobox::Core; 5 | 6 | is "Hello, World\n"->uc, "HELLO, WORLD\n"; 7 | 8 | my @list = (1, 5, 9, 2, 0, 4, 2, 1); 9 | is_deeply [@list->sort->reverse], [9,5,4,2,2,1,1,0]; 10 | 11 | # works with references too! 12 | my $list = [1, 5, 9, 2, 0, 4, 2, 1]; 13 | is_deeply [$list->sort->reverse], [9,5,4,2,2,1,1,0]; 14 | 15 | my %hash = ( 16 | grass => 'green', 17 | apple => 'red', 18 | sky => 'blue', 19 | ); 20 | 21 | is [10, 20, 30, 40, 50]->pop, 50; 22 | is [10, 20, 30, 40, 50]->shift, 10; 23 | 24 | my $lala = "Lalalalala\n"; 25 | is "chomp: "->concat($lala->chomp, " ", $lala), "chomp: 1 Lalalalala"; 26 | 27 | my $hashref = { foo => 10, bar => 20, baz => 30, qux => 40 }; 28 | 29 | is $hashref->keys->sort->join(' '), "bar baz foo qux"; 30 | 31 | -------------------------------------------------------------------------------- /t/system.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | use autobox::Core; 5 | 6 | is $^X->system(qw(-e1)), 0; 7 | -------------------------------------------------------------------------------- /t/tail.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 7; 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar baz); 8 | 9 | ok @array->tail; 10 | is_deeply [@array->tail], ['bar', 'baz']; 11 | 12 | is_deeply [@array->tail(1)], ['baz']; 13 | is_deeply [@array->tail(2)], ['bar', 'baz']; 14 | is_deeply [@array->tail(3)], ['foo', 'bar', 'baz']; 15 | 16 | my @tail = @array->tail; 17 | is scalar @tail, 2, "Returns a list in list context"; 18 | 19 | my $tail = @array->tail; 20 | is ref $tail, 'ARRAY', "Returns an arrayref in scalar context"; 21 | -------------------------------------------------------------------------------- /t/uc.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my $string = "this is a string"; 8 | 9 | is $string->uc, "THIS IS A STRING"; 10 | 11 | -------------------------------------------------------------------------------- /t/ucfirst.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my $string = "this is a string"; 8 | 9 | is $string->ucfirst, "This is a string"; 10 | 11 | -------------------------------------------------------------------------------- /t/undef.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | use autobox::Core; 5 | 6 | my $foo = 'foo'; 7 | is $foo->undef, undef; 8 | 9 | is_deeply [1,2,3]->undef, []; 10 | is_deeply {foo => 123}->undef, +{}; 11 | -------------------------------------------------------------------------------- /t/uniq.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 3; 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar baz); 8 | my @array_cp = @array; 9 | 10 | my @uniq = @array_cp->uniq; 11 | 12 | is_deeply \@array_cp, \@uniq; 13 | 14 | @array_cp = (@array, @array); 15 | @uniq = @array_cp->uniq; 16 | 17 | is_deeply \@uniq, \@array; # this assumes that the duplicate filtering is stable (doesn't re-sort the values), which isn't a promise it makes 18 | 19 | is_deeply [ [undef, 1, 2, 1, 2, ]->uniq ], [ undef, 1, 2]; 20 | -------------------------------------------------------------------------------- /t/unpack.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | SKIP: { 8 | skip "Only for 5.10", 1, if $] < 5.010; 9 | is 'W'->unpack("foo"), unpack('W', "foo"); 10 | }; 11 | -------------------------------------------------------------------------------- /t/unshift.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my @array = qw(foo bar); 8 | 9 | my @returned = @array->unshift('baz'); 10 | 11 | is_deeply \@array, [qw(baz foo bar)]; 12 | is_deeply \@returned, [qw(baz foo bar)]; 13 | 14 | my $arrayref = @array->unshift('baz'); 15 | 16 | is ref $arrayref, 'ARRAY', "Returns arrayref in scalar context"; 17 | 18 | my $array = [qw(foo bar)]; 19 | 20 | $array->unshift('baz'); 21 | 22 | is_deeply $array, [qw(baz foo bar)]; 23 | 24 | -------------------------------------------------------------------------------- /t/values.t: -------------------------------------------------------------------------------- 1 | use Test::More qw(no_plan); 2 | use strict; 3 | use warnings; 4 | 5 | use autobox::Core; 6 | 7 | my %hash = ( foo => 1, bar => 2, baz => 3 ); 8 | 9 | is_deeply [ sort %hash->values ], [ qw( 1 2 3 ) ]; 10 | 11 | my $arrayref = %hash->values; 12 | 13 | is ref $arrayref, 'ARRAY', "Returns arrayref in scalar context"; 14 | 15 | -------------------------------------------------------------------------------- /t/vec.t: -------------------------------------------------------------------------------- 1 | 2 | use Test::More qw(no_plan); 3 | use strict; 4 | use warnings; 5 | 6 | use autobox::Core; 7 | 8 | my $foo = ''; 9 | 10 | is $foo->vec(0, 32), vec($foo, 0, 32); # 0x5065726C, 'Perl' 11 | is $foo->vec(2, 16), vec($foo, 2, 16); # 0x5065, 'PerlPe' 12 | is $foo->vec(3, 16), vec($foo, 3, 16); # 0x726C, 'PerlPerl' 13 | --------------------------------------------------------------------------------