summaryrefslogtreecommitdiff
path: root/Quick
blob: 13d6ae0b927088536349553537174e5f2f82dca5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
#!/usr/local/bin/perl5
#
# This document is in the public domain.
#
# The purpose is to document by example some of the new Perl5 features.
# It also functions as a mini test suite; you can extracted the
# expected output using:
#     perl -ne 'm/.*prints ``(.*)..$/ && print $1,"\n";'
# There are a couple of places that print out internal address so it's
# not perfect yet, those should be fixed.
#
# Thanks to the following for their input:
#     Johan.Vromans@NL.net
#     Daniel Faken <absinthe@viva.chem.washington.edu>
#     Tom Christiansen <tchrist@wraeththu.cs.colorado.edu>
#     Dean Roehrich <roehrich@ferrari.cray.com>
#     Larry Wall <lwall@netlabs.com>
#
# TODO when I get perl5a6 to play with
#	*foo = \&func;			# replaces only function (etc)
#	AUTOLOAD { ...; }		# called if method not found
#	goto &func;			# goto's a function
#	require FOOBAR;			# loads FOOBAR.pm
#	@ISA
#
#	import()/@EXPORT/etc

#   my
	# static scoping
	sub samp1 { print $z,"\n"; }
	sub samp2 { my($z) = "world"; &samp1; }
	$z = "hello"; &samp2;		# prints ``hello''

#   package;
	# for catching non-local variable references
	sub samp3 {
	    my $x = shift;		# local() would work also
	    package;			# empty package
	    $main::count += $x;		# this is ok.
	    # $y = 1;			# compile time error
	}

#   =>
	# works like comma (,); use for key/value pairs
        # sometimes used to disambiguate the final expression in a block
	# might someday supply warnings if you get out of sync
	%foo = ( abc => foo );
	print $foo{abc},"\n";		# prints ``foo''

#   ::
	# works like tick (') (use of ' is deprecated in perl5)
        print $main::foo{abc},"\n";	# prints ``foo''

#   bless ref;
	# Bless takes a reference and returns an "object"
	$oref = bless \$scalar;

#   ->
	# dereferences an "object"
	$x = { def => bar };		# $x is ref to anonymous hash
	print $x->{def},"\n";		# prints ``bar''

	# method derefs must be bless'ed
	{
	    package sample;
	    sub samp4 { my($this) = shift; print $this->{def},"\n"; }
	    sub samp5 { print "samp5: @_\n"; }
	    $main::y = bless $main::x;	# $x is ref, $y is "object"
	}
	$y->samp4();			# prints ``bar''

	# indirect object calls
	samp5 $y arglist;		# prints ``samp5: sample=HASH(0xa85e0) arglist''

	# static method calls (often used for constructors, see below)
	samp5 sample arglist;		# prints ``samp5: sample arglist''

#   function calls without &
	sub samp6 { print "look ma\n"; }
	samp6;				# prints ``look ma''

#   ref
	# returns "object" type
	{
	    package OBJ1;
	    $x = bless \$y;		# returns "object" $x in "class" OBJ1
	    print ref $x,"\n";		# prints ``OBJ1''
	}

	# and non-references return undef.
	$z = 1;
	print "non-ref\n" if !defined(ref $z);		# prints ``non-ref''

	# ref's to "builtins" return type
	print ref \$ascalar,"\n";		# prints ``SCALAR''
	print ref \@array,"\n";			# prints ``ARRAY''
	print ref \%hash,"\n";			# prints ``HASH''
	sub func { print shift,"\n"; }
	print ref \&func,"\n";			# prints ``CODE''
	print ref \\$scalar,"\n";		# prints ``REF''

#   tie
	# bind a variable to a package with magic functions:
        #     new, fetch, store, delete, firstkey, nextkey (XXX: others???)
	# Usage: tie variable, PackageName, ARGLIST
	{
	    package TIEPACK;
	    sub new { print "NEW: @_\n"; my($class, $x) = @_; bless \$x }
	    sub fetch { print "fetch @_\n"; my($this) = @_; ${$this} }
	    sub store { print "store @_\n"; my($this, $x) = @_; ${$this} = $x }
	    sub DESTROY { print "DESTROY @_\n" }
	}
	tie $h, TIEPACK, "black_tie";	# prints ``NEW: TIEPACK black_tie''
	print $h, "\n";			# prints ``fetch TIEPACK=SCALAR(0x882a0)''
					# prints ``black_tie''
	$h = 'bar';			# prints ``store TIEPACK=SCALAR(0x882a0) bar''
	untie $h;			# DESTROY (XXX: broken in perl5a5???)

#   References and Anonymous data-structures
	$sref = \$scalar;		# $$sref is scalar
	$aref = \@array;		# @$aref is array
	$href = \%hash;			# %$href is hash table
	$fref = \&func;			# &$fref is function
	$refref = \$fref;		# ref to ref to function
	&$$refref("call the function");	# prints ``call the function''

	%hash = ( abc => foo );		# hash (just like perl4)
	print $hash{abc},"\n";		# prints ``foo''
	$ref = { abc => bar };		# reference to anon hash
	print $ref->{abc},"\n";		# prints ``bar''

	@ary = ( 0, 1, 2 );		# array (just like perl4)
	print $ary[1],"\n";		# prints ``1''
	$ref = [ 3, 4, 5 ];		# reference to anon array
	print $ref->[1],"\n";		# prints ``4''

#   Nested data-structures
	@foo = ( 0, { name => foobar }, 2, 3 );		# $#foo == 3
	$aref = [ 0, { name => foobar }, 2, 3 ];	# ref to anon array
	$href = {					# ref to hash of arrays
	    John => [ Mary, Pat, Blanch ],
	    Paul => [ Sally, Jill, Jane ],
	    Mark => [ Ann, Bob, Dawn ],
	};
	print $href->{Paul}->[0], "\n";			# prints ``Sally''
	print $href->{Paul}[0],"\n";			# shorthand version, prints ``Sally''

#   Multiple Inheritence (get rich quick :-)
	{
	    package OBJ2; sub abc { print "abc\n"; }
	    package OBJ3; sub def { print "def\n"; }
	    package OBJ4; @ISA = ("OBJ2", "OBJ3");
	    $x = bless { foo => bar };
	    $x->abc;					# prints ``abc''
	    $x->def;					# prints ``def''
	}

#   Packages, Classes, Objects, Methods, Constructors, Destructors, etc.
    	# XXX: I'll add more explinations/samples about the above here
	{
	    package OBJ5;
	    sub new { print "NEW: @_\n"; my($x) = "empty"; bless \$x }
	    sub DESTROY { print "DESTROY\n" }
	    sub output { my($this) = shift; print "value = $$this\n"; }
	}
	# Constructors are often written as static method calls:
	$x = new OBJ5;		# prints ``NEW: OBJ5''
	$x->output;		# prints ``value = empty''
	# The destructor is responsible for calling any base class destructors.
	undef $x;