dslinux/user/perl/lib/Attribute/Handlers/demo Demo.pm Descriptions.pm MyClass.pm demo.pl demo2.pl demo3.pl demo4.pl demo_call.pl demo_chain.pl demo_cycle.pl demo_hashdir.pl demo_phases.pl demo_range.pl demo_rawdata.pl

[cayenne]

Update of /cvsroot/dslinux/dslinux/user/perl/lib/Attribute/Handlers/demo
In directory antilope:/tmp/cvs-serv7729/lib/Attribute/Handlers/demo

Added Files:
	Demo.pm Descriptions.pm MyClass.pm demo.pl demo2.pl demo3.pl 
	demo4.pl demo_call.pl demo_chain.pl demo_cycle.pl 
	demo_hashdir.pl demo_phases.pl demo_range.pl demo_rawdata.pl 
Log Message:
Adding fresh perl source to HEAD to branch from

--- NEW FILE: MyClass.pm ---
package MyClass;
$VERSION = '1.00';
use v5.6.0;
use base Attribute::Handlers;
no warnings 'redefine';


sub Good : ATTR(SCALAR) {
	my ($package, $symbol, $referent, $attr, $data) = @_;

	# Invoked for any scalar variable with a :Good attribute,
	# provided the variable was declared in MyClass (or
	# a derived class) or typed to MyClass.

	# Do whatever to $referent here (executed in CHECK phase).
	local $" = ", ";
	print "MyClass::Good:ATTR(SCALAR)(@_);\n";
};

sub Bad : ATTR(SCALAR) {
	# Invoked for any scalar variable with a :Bad attribute,
	# provided the variable was declared in MyClass (or
	# a derived class) or typed to MyClass.
	local $" = ", ";
	print "MyClass::Bad:ATTR(SCALAR)(@_);\n";
}

sub Good : ATTR(ARRAY) {
        # Invoked for any array variable with a :Good attribute,
        # provided the variable was declared in MyClass (or
        # a derived class) or typed to MyClass.
	local $" = ", ";
	print "MyClass::Good:ATTR(ARRAY)(@_);\n";
};

sub Good : ATTR(HASH) {
        # Invoked for any hash variable with a :Good attribute,
        # provided the variable was declared in MyClass (or
        # a derived class) or typed to MyClass.
	local $" = ", ";
	print "MyClass::Good:ATTR(HASH)(@_);\n";
};

sub Ugly : ATTR(CODE) {
        # Invoked for any subroutine declared in MyClass (or a 
        # derived class) with an :Ugly attribute.
	local $" = ", ";
	print "MyClass::UGLY:ATTR(CODE)(@_);\n";
};

sub Omni : ATTR {
        # Invoked for any scalar, array, hash, or subroutine
        # with an :Omni attribute, provided the variable or
        # subroutine was declared in MyClass (or a derived class)
        # or the variable was typed to MyClass.
        # Use ref($_[2]) to determine what kind of referent it was.
	local $" = ", ";
	my $type = ref $_[2];
	print "MyClass::OMNI:ATTR($type)(@_);\n";
	use Data::Dumper 'Dumper';
	print Dumper [ \@_ ];
};

1;

--- NEW FILE: demo3.pl ---
package main;
use MyClass;

my MyClass $x :Good :Bad(1**1-1) :Omni(vorous);

package SomeOtherClass;
use base MyClass;

sub tent { 'acle' }

sub w :Ugly(sister) :Omni('po',tent()) {}

my @y :Good :Omni(s/cie/nt/);

my %y :Good(q/bye) :Omni(q/bus/);


--- NEW FILE: demo_chain.pl ---
#! /usr/local/bin/perl -w

use Attribute::Handlers;

sub Prefix : ATTR {
  my ($glob, $sub) = @_[1,2];
  no warnings 'redefine';
  *$glob = sub {
                 print "This happens first\n";
                 $sub->(@_);
               };
}

sub Postfix : ATTR {
  my ($glob, $sub) = @_[1,2];
  no warnings 'redefine';
  *$glob = sub {
                 $sub->(@_);
                 print "This happens last\n";
               };
}

sub test : Postfix Prefix {
  print "Hello World\n";
}

test();

--- NEW FILE: demo_phases.pl ---
#! /usr/local/bin/perl -w

use Attribute::Handlers;
use Data::Dumper 'Dumper';

sub UNIVERSAL::Beginner : ATTR(SCALAR,BEGIN,END)
	{ print STDERR "Beginner: ", Dumper \@_}

sub UNIVERSAL::Checker : ATTR(CHECK,SCALAR)
	{ print STDERR "Checker: ", Dumper \@_}

sub UNIVERSAL::Initer : ATTR(SCALAR,INIT)
	{ print STDERR "Initer: ", Dumper \@_}

package Other;

my $x :Initer(1) :Checker(2) :Beginner(3);
my $y :Initer(4) :Checker(5) :Beginner(6);

--- NEW FILE: demo.pl ---
#! /usr/local/bin/perl -w

use v5.6.0;
use base Demo;

my $y : Demo :This($this) = sub : Demo(1,2,3) {};
sub x : Demo(4, 5, 6) :Multi {}
my %z : Demo(hash) :Multi(method,maybe);
# my %a : NDemo(hash);

{
	package Named;

	use base Demo;

	sub Demo :ATTR(SCALAR) { print STDERR "tada\n" }

	my $y : Demo :This($this) = sub : Demo(1,2,3) {};
	sub x : ExplMulti :Demo(4,5,6) {}
	my %z : ExplMulti :Demo(hash);
	my Named $q : Demo;
}

package Other;

my Demo $dother : Demo :This($this) = "okay";
my Named $nother : Demo :This($this) = "okay";

# my $unnamed : Demo;

# sub foo : Demo();

--- NEW FILE: demo_range.pl ---
package UNIVERSAL;
use Attribute::Handlers;
use Tie::RangeHash;

sub Ranged : ATTR(HASH) {
	my ($package, $symbol, $referent, $attr, $data) = @_;
	tie %$referent, 'Tie::RangeHash';
}

package main;

my %next : Ranged;

$next{'cat,dog'} = "animal";
$next{'fish,fowl'} = "meal";
$next{'heaven,hell'} = "reward";

while (<>) {
	chomp;
	print $next{$_}||"???", "\n";
}

--- NEW FILE: Demo.pm ---
$DB::single = 1;

package Demo;
$VERSION = '1.00';
use Attribute::Handlers;
no warnings 'redefine';

sub Demo : ATTR(SCALAR) {
	my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
	$data = '<undef>' unless defined $data;
	print STDERR 'Scalar $', *{$symbol}{NAME},
		     " ($referent) was ascribed ${attr}\n",
		     "with data ($data)\nin phase $phase\n";
};

sub This : ATTR(SCALAR) {
	print STDERR "This at ",
		     join(":", map { defined() ? $_ : "" } caller(1)),
		     "\n";
}

sub Demo : ATTR(HASH) {
	my ($package, $symbol, $referent, $attr, $data) = @_;
	$data = '<undef>' unless defined $data;
	print STDERR 'Hash %', *{$symbol}{NAME},
		     " ($referent) was ascribed ${attr} with data ($data)\n";
};

sub Demo : ATTR(CODE) {
	my ($package, $symbol, $referent, $attr, $data) = @_;
	$data = '<undef>' unless defined $data;
	print STDERR 'Sub &', *{$symbol}{NAME},
		     " ($referent) was ascribed ${attr} with data ($data)\n";
};

sub Multi : ATTR {
	my ($package, $symbol, $referent, $attr, $data) = @_;
	$data = '<undef>' unless defined $data;
	print STDERR ref($referent), ' ', *{$symbol}{NAME},
		     " ($referent) was ascribed ${attr} with data ($data)\n";
};

sub ExplMulti : ATTR(ANY) {
	my ($package, $symbol, $referent, $attr, $data) = @_;
	$data = '<undef>' unless defined $data;
	print STDERR ref($referent), ' ', *{$symbol}{NAME},
		     " ($referent) was ascribed ${attr} with data ($data)\n";
};

1;

--- NEW FILE: demo2.pl ---
#! /usr/local/bin/perl -w

use v5.6.0;
use base Demo;
no warnings 'redefine';

my %z1 :Multi(method?maybe);
my %z2 :Multi(method,maybe);
my %z3 :Multi(qw(method,maybe));
my %z4 :Multi(qw(method maybe));
my %z5 :Multi('method','maybe');

sub foo :Demo(till=>ears=>are=>bleeding) {}
sub foo :Demo(['till','ears','are','bleeding']) {}
sub foo :Demo(qw/till ears are bleeding/) {}
sub foo :Demo(till,ears,are,bleeding) {}

sub foo :Demo(my,ears,are,bleeding) {}
sub foo :Demo(my=>ears=>are=>bleeding) {}
sub foo :Demo(qw/my, ears, are, bleeding/) {}
sub foo :Demo(qw/my ears are bleeding) {}

--- NEW FILE: demo_rawdata.pl ---
package UNIVERSAL;
use Attribute::Handlers;

sub Cooked : ATTR(SCALAR) { print pop, "\n" }
sub PostRaw : ATTR(SCALAR,RAWDATA) { print pop, "\n" }
sub PreRaw : ATTR(SCALAR,RAWDATA) { print pop, "\n" }

package main;

my $x : Cooked(1..5);
my $y : PreRaw(1..5);
my $z : PostRaw(1..5);

--- NEW FILE: demo_call.pl ---
#! /usr/local/bin/perl -w

use Attribute::Handlers;

sub Call : ATTR {
	use Data::Dumper 'Dumper';
	print Dumper [ @_ ];
}


sub x : Call(some,data) { };

--- NEW FILE: demo_cycle.pl ---
package Selfish;

sub TIESCALAR {
	use Data::Dumper 'Dumper';
	print Dumper [ \@_ ];
	bless [ @_[1..$#_] ], $_[0];
}

sub FETCH {
	use Data::Dumper 'Dumper';
	Dumper [ @{$_[0]} ];
}

package main;

use Attribute::Handlers autotieref => { Selfish => Selfish };

my $next : Selfish("me");
print "$next\n";

my $last : Selfish("you","them","who?");
print "$last\n";

my $other : Selfish(["you","them","who?"]);
print "$other\n";

--- NEW FILE: demo4.pl ---
use Descriptions;

my $capacity : Name(capacity)
	     : Purpose(to store max storage capacity for files)
	     : Unit(Gb);

package Other;

sub foo : Purpose(to foo all data before barring it) { }

--- NEW FILE: demo_hashdir.pl ---
use Attribute::Handlers autotie => { Dir => 'Tie::Dir qw(DIR_UNLINK)' };

my %dot : Dir('.', DIR_UNLINK);

print join "\n", keys %dot;

delete $dot{killme};

print join "\n", keys %dot;

--- NEW FILE: Descriptions.pm ---
package Descriptions;
$VERSION = '1.00';

use Attribute::Handlers;

my %name;

sub name {
	return $name{$_[2]}||*{$_[1]}{NAME};
}

sub UNIVERSAL::Name :ATTR {
	$name{$_[2]} = $_[4];
}

sub UNIVERSAL::Purpose :ATTR {
	print STDERR "Purpose of ", &name, " is $_[4]\n";
}

sub UNIVERSAL::Unit :ATTR {
	print STDERR &name, " measured in $_[4]\n";
}


1;