3 ###############################################################################
5 ## Copyright (c) 2000 - 2004 by Steffen Beyer. ##
6 ## All rights reserved. ##
8 ## This program is free software; you can redistribute it ##
9 ## and/or modify it under the same terms as Perl itself. ##
11 ###############################################################################
13 ######################################################################
15 # How to emulate the Set::Object module using Bit::Vector (example): #
17 ######################################################################
22 use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION );
28 @EXPORT_OK = qw( RegisterMe ID2Obj Obj2ID Registered );
29 %EXPORT_TAGS = (all => [@EXPORT_OK]);
40 if (exists $obj2id{$self})
42 warn "Object '$self' has already been registered!\n";
43 return $obj2id{$self};
57 return exists($id2obj{$id}) ? $id2obj{$id} : undef;
64 return exists($obj2id{$self}) ? $obj2id{$self} : undef;
76 use Date::Calc::Object;
77 use Bit::Vector::Overload;
79 push( @Date::Calc::ISA, 'InheritMe' ); # (make Date::Calc a subclass)
81 InheritMe->import(':all'); # (as a convenience for dealing with non-objects)
83 Date::Calc->date_format(2);
85 my $today = Date::Calc->today();
86 my $yesterday = $today - 1;
87 my $tomorrow = $today + 1;
90 print "'$yesterday' has got ID #", $yesterday->RegisterMe(), "\n";
91 print "'$today' has got ID #", $today->RegisterMe(), "\n";
92 print "'$tomorrow' has got ID #", $tomorrow->RegisterMe(), "\n";
96 my $oranges = 'out of stock';
99 print "\$pears ('$pears') has got ID #", RegisterMe(\$pears), "\n";
100 print "\$apples ('$apples') has got ID #", RegisterMe(\$apples), "\n";
101 print "\$oranges ('$oranges') has got ID #", RegisterMe(\$oranges), "\n";
103 my $set1 = Bit::Vector->new(&Registered);
104 my $set2 = Bit::Vector->new(&Registered);
106 $set1->Bit_On( $today->Obj2ID() );
107 $set1->Bit_On( Obj2ID(\$pears) );
108 $set1->Bit_On( Obj2ID(\$apples) );
109 $set1->Bit_On( Obj2ID(\$oranges) );
111 $set2->Bit_On( $yesterday->Obj2ID() );
112 $set2->Bit_On( $today->Obj2ID() );
113 $set2->Bit_On( $tomorrow->Obj2ID() );
114 $set2->Bit_On( Obj2ID(\$oranges) );
123 ref($_) =~ /^[A-Z]+$/ ? "${$_}" : "$_",
126 InheritMe->ID2Obj($_),
127 $set1->Index_List_Read()
140 ref($_) =~ /^[A-Z]+$/ ? "${$_}" : "$_",
143 InheritMe->ID2Obj($_),
144 $set2->Index_List_Read()
150 my $intersection = $set1 & $set2;
152 print "\nIntersection:\n";
159 ref($_) =~ /^[A-Z]+$/ ? "${$_}" : "$_",
162 InheritMe->ID2Obj($_),
163 $intersection->Index_List_Read()