# -*- perl -*-
# $Id: PerlTemplate.txt,v 1.12 2003/05/11 06:16:02 stephens Exp $

[% MACRO other BLOCK %]
  [% FOREACH x = end.opposite %]
  [% NEXT UNLESS x.isNavigable %]

    $old->remove_[% x.name %]($self) if $old;
    $val->add_[% x.name %]($self)    if $val;

  [% END %]
[% END %]

#//-// FILE BEGIN [%model_package_file%]

# -*- perl -*-
# DO NOT EDIT - This file is generated by UML2CODE.
# From template: $Id: PerlTemplate.txt,v 1.12 2003/05/11 06:16:02 stephens Exp $

package [%model_package%];

use 5.6.1;
use strict;
use warnings;

# Import them all!!!
# [ % model_package_use % ];

my $factory_map = 
[
  [% FOREACH x = factory_map %]
    '[% x %]',
  [% END %]
];

=head2 factory_map

Returns an array ref that maps all UML Model names to Perl package names.
Also includes short name to fully-qualified name mappings. 

=cut
sub factory_map { $factory_map; }
       
my $model;

[% PERL %]
[% END %]

=head2 model

Returns the UML meta-model Model object for this Model.

=cut
sub model { $model; }
       
my $factory;

=head2 factory

Returns a factory for this Model.

=cut
sub factory 
{
  # $DB::single = 1;

  my $self = shift;
  unless ( $factory ) {
    use UML::MetaMetaModel::Factory;
    $factory = UML::MetaMetaModel::Factory->new('classMap' => $self->factory_map);
  }
  $factory;
}

############################################################################

1; # Is true!!!

############################################################################

### Keep these comments at end of file: ks.perl@kurtstephens.com 2003/04/06 ###
### Local Variables: ###
### mode:perl ###
### perl-indent-level:2 ###
### perl-continued-statement-offset:0 ###
### perl-brace-offset:0 ###
### perl-label-offset:0 ###
### End: ###

#//-// FILE END [% model_package_file %] 

#//-// FILE BEGIN [% base_package_file %]

# -*- perl -*-
# DO NOT EDIT - This file is generated by UML2CODE.
# From template: $Id: PerlTemplate.txt,v 1.12 2003/05/11 06:16:02 stephens Exp $

package [% base_package %];

# This package provides base class support for generated Classifiers.

use 5.6.1;
use strict;
use warnings;

#################################################################
# Dependencies
#

use Carp qw(croak confess);

#################################################################
# Dynamic loading
#


my %__use;

=head2 __use

  my $pkg = $self->__use('Some::Package');
  my $new_obj = $pkg->new(...);

Dynamically "use" a package.

=cut
sub __use
{
  my ($self, $cls) = @_;

  $cls ||= $self;

  unless ( $__use{$cls} ) {
    # $DB::single = 1;
    no strict 'refs';
    unless ( ${"${cls}::VERSION"} ) {
      use Carp qw(confess);
      # $DB::single = 1;
      eval "use $cls"; confess "Attempting use:\n$@" if $@;
      ${"${cls}::VERSION"} ||= 1;
    }
    $__use{$cls} = 1;
  }

  $cls;
}


#################################################################
# Introspection
#

=head2 __factory

Returns the factory object for this Classifier's Model.

=cut
# 'emacs
sub __factory 
{ 
  __use('[% model_package %]')->factory;
}

=head2 __metamodel

Returns the Model for this Classifier.

=cut
sub __metamodel 
{
  __use('[% model_package %]')->model;
}


my %__classifier;
=head2 __classifier

  my $classifier = $obj_or_package->__classifier;

Returns the UML meta-model Classifier for an object or package.

=cut
sub __classifier 
{ 
  my ($self) = @_;
  
  my $name = ref($self) || $self;

  my $cls;
  unless ( $cls = $__classifier{$name} ) {
    use UML::MetaMetaModel::Util qw(Namespace_ownedElement_name_);
    $cls = $__classifier{$name} = 
    Namespace_ownedElement_name_($self->__metamodel, $self->__model_name);
  }
  
  $cls;
}


#################################################################
# Validation.
#

=head2 __validate_type

  Some::Package->__validate_type($value);

Returns true if a value is a valid representation of this Classifier.

=cut
sub __validate_type { 1 }


=head2 __typecheck

  Some::Package->__typecheck($value, $msg);

Generates an exception with C<$msg> if C<$value> is not a valid representaion of this Classifier.

=cut
sub __typecheck { $_[1] }


#################################################################
# Initialization.
#


=head2 _initialize

Initialize all slots in an instance with initial values.

=cut
sub _initialize { shift }


=head2 __initialize

Initialize all slots of a particular Classifier's Attributes and AssociationEnds.

=cut
#'emacs
sub __initialize { shift }


#################################################################
# Instantiation.
#

my $_id = 0;

=head2 __new_instance

Returns a new instance, without initializing.

=cut
sub __new_instance
{
  my ($self, %attrs) = @_;
  $attrs{'_id'} ||= ++ $_id;
  bless(\%attrs, ref($self) || $self);
}

=head2 new

Returns a new instance, initializing the associations.

=cut
sub new
{
  my ($self, @opts) = @_;

  # $DB::single = 1;

  # Allow _initialize method to delegate instantation.
  $self->__new_instance(@opts)->_initialize;
}


=head2 __clone

Returns a new cloned instance.

=cut
sub __clone
{
  my ($self) = @_;

  $self = bless({ %$self }, ref($self));

  $self->{'_id'} .= '.' . ++ $_id;

  # Clone all attributes.
  for my $key ( keys %$self ) {
    my $v = $self->{$key};
    if ( ref($v) eq 'ARRAY' ) {
      $self->{$key} = [ @$v ];
    } elsif ( ref($v) eq 'HASH' ) {
      $self->{$key} = { %$v };
    }
  }

  $self->__clone_deepen;
}


sub __clone_deepen
{
  my ($self) = @_;

  # Clone all the aggegrated Associations.

  $self;
}



#################################################################


use vars qw($AUTOLOAD);

our $AUTOLOAD_verbose = 0;


sub __true { 1 };
sub __false { 1 };


my %__isa;


=head2 AUTOLOAD

Autoloader to simplify isa<Classifier>() handling of disjoint types.
This also prints a verbose stack trace for an unimplemented method.

=cut
sub AUTOLOAD
{
  no strict 'refs';
  
  my ($self, @args) = @_;
  local ($1, $2);
  
  my ($package, $operation) = $AUTOLOAD =~ m/^(?:(.+)::)([^:]+)$/;
  return if $operation eq 'DESTROY';
  
  my ($method); # The autogenerated method.
  
  #$DB::single = 1;
  
  # warn __PACKAGE__ . ": package='$package' operation='$operation'";
  
  # Handle isa<Classifier> automagically.
  # better check your spelling!!
  if ( $operation =~ /^isa[A-Z]/ ) {
    my $ref = ref($self) || $self;

    # Install true method in $self class, not any superclass.
    $AUTOLOAD = "${ref}::${operation}";

    # Check a false cache.
    my $method = $__isa{$AUTOLOAD};
    unless ( defined $method ) {
      my @x = @{"${ref}::ISA"};
      while ( @x ) {
	my $x = pop @x;
	if ( UNIVERSAL::can($x, $operation) && $x->$operation ) {
	  $method = \&__true;
	  last;
	}
	push(@x, @{"${x}::ISA"});
      }
      $__isa{"$ref\t$operation"} = 0;
    }

    # Do not install false method, so multiple-inheritance will work.
    # print STDERR "$ref \t $operation \t = $method->()\n";
    return undef unless $method;
  }
  
  # Install the generated method and invoke it.
  if ( $method ) {
    *{$AUTOLOAD} = $method;
    # Tail call.
    goto &$method;
  } else {
    use Carp qw(confess);
    use Data::Dumper;

    # Nice feature:
    # Print a stack trace if an undefined method is called.
    # Why doesn't Perl always do this?
    my $e = 
    [
     'UndefinedMethod',
     'package'   => $package,
     'operation' => $operation,
     'receiver'  => "$self",
     'arguments' => [ map("$_", @args) ],
     ];

    confess(Data::Dumper->new([$e],[qw(EXCEPTION)])->Dump);
  }
}  

1; # Is true!!!

#//-// FILE END [% base_package_file %]

[% FOREACH cls = classifier %]

#//-// FILE BEGIN [% cls.package_file %]

# -*- perl -*-
# DO NOT EDIT - This file is generated by UML2CODE.
# From template: $Id: PerlTemplate.txt,v 1.12 2003/05/11 06:16:02 stephens Exp $

package [% cls.package %];

use 5.6.1;
use strict;
use warnings;

#################################################################
# Version
#

our $VERSION = do { my @r = (q$Revision: 1.12 $ =~ /\d+/g); sprintf "%d." . "%03d" x $#r, @r };

#################################################################
# Dependencies
#

[% FOREACH dep = cls.usage %]
use [% dep.package %];
[% END %]

[% FOREACH dep = cls.usage %]
use [% dep.package %];
[% END %]

use Carp qw(croak confess);

#################################################################
# Generalizations
#

[% IF cls.supers %]
use base qw(
[% FOREACH super = cls.supers %]
  [% super %]
[% END %]

[% FOREACH super = cls.supers_default %]
  [% super %]
[% END %]

[% IF cls.isaEnumeration %]
  Exporter
[% END %]

);
[% END %]

#################################################################
# Exports
#

our @EXPORT_OK = qw(
[% IF cls.isaEnumeration %]
  [% FOREACH literal = cls.literal %]
    [% literal.NAME %]
  [% END %]
[% END %]
);
our %EXPORT_TAGS = ( ':all' => \@EXPORT_OK );

[% IF cls.primitive || cls.construct %]

#################################################################
# Instantiation
#

=head2 new

Constructs new [% cls.package %] value.

=cut
sub new
{
  my ($self, @args) = @_;

  my $x = pop(@args);

  [% IF cls.construct %]
  $x = [% cls.construct %]
  ;
  [% END %]

  __typecheck($self, $x, '[% cls.package %]::new');

  $x;
}

[% ELSIF cls.isaEnumeration %]
=head2 new

  my $x = [% cls.package %]->new($literal);

Constructs new [% cls.package %] literal value.
C<$literal> can be one of the following:

=over 4

[% FOREACH literal = cls.literal %]

=item * '[% literal.name %]'


[% END %]

=back

=cut
sub new
{
  my ($self, @args) = @_;
  my $x = pop(@args);
  __typecheck($self, $x, '[% cls.package %]::new');
  $x;
}

[% END %]


[% IF cls.isaEnumeration %]

#################################################################
# EnumerationLiterals
#

[% FOREACH literal = cls.literal %]

=head2 [% literal.NAME %]

Returns '[% literal.name %]'.

=cut
sub [% literal.NAME %]
{
  '[% literal.name %]';
}

[% END %]

[% END %]


#################################################################
# Validation
#

[% IF cls.isaEnumeration %]
[% DEFAULT cls.validate_type = '$__literal{$x}' %]
my %__literal = 
(
 [% FOREACH literal = cls.literal %]
   '[% literal.name %]' => '[% literal.name %]',
 [% END %]
 );
[% END %]
[% DEFAULT cls.validate_type = "UNIVERSAL::isa(\$x, '${cls.package}')" %]

=head2 __validate_type

  [%cls.package%]->__validate_type($value);

Returns true if $value is a valid value of [%cls.package%].

=cut
sub __validate_type($$)
{
  my ($self, $x) = @_;

  no warnings;

  [% cls.validate_type %]
  ;
}


=head2 __typecheck

  [%cls.package%]->__typecheck($value, $msg);

Calls C<confess()> with C<$msg> if C<[%cls.package%]-E<GT>__validate_type($value)> is false.

=cut
sub __typecheck
{
  my ($self, $x, $msg) = @_;

  confess("typecheck: $msg: type '[%cls.package%]': value '$x'")
    unless __validate_type($self, $x);
}


=head2 isa[% cls.name_ %]


Returns true if receiver is a C<[% cls.package %]>.
Other receivers will return false.

=cut
sub isa[% cls.name_ %] { 1 }


[% IF cls.name_q_ != cls.name_ %]
=head2 isa[% cls.name_q_ %]


Returns true if receiver is a C<[% cls.package %]>.
Other receivers will return false.
This is the fully qualified version of the C<isa[% cls.name_ %]> method.

=cut
sub isa[% cls.name_q_ %] { 1 }
[% END %]


#################################################################
# Introspection
#

=head2 __model_name 

  my $name = $obj_or_package->__model_name;

Returns the UML Model name (C<'[% cls.name_q %]'>) for an object or package of
this Classifier.

=cut
sub __model_name { '[% cls.name_q %]' }



[% FOREACH attr = cls.attribute %]

[% IF attr.instance %]
  [% SET attr.loc = "\$self->{'${attr.name}'}" %]
[% ELSE %]
  [% SET attr.loc = "\$${attr.name}" %]
[% END %]

[% SET attr.typecheck = "\$self->__use('${attr.type}')->__typecheck(\$val, \"${cls.package}.${attr.name}\")" %]

[% END %]


[% FOREACH cls_end = cls.association %]
# ASSOC: [% cls_end.name %]

[% FOREACH end = cls_end.opposite %]
[% NEXT UNLESS end.isNavigable %]

[% IF end.instance %]
  [% SET end.loc = "\$self->{'${end.name}'}" %]
[% ELSE %]
  [% SET end.loc = "\$${end.name}" %]
[% END %]

[% SET end.typecheck = "\$self->__use('${end.type}')->__typecheck(\$val, \"${cls.package}.${end.name}\")" %]

[% END %]
[% END %]

#################################################################
# Class Attributes
#


[% FOREACH attr = cls.attribute %]
  [% UNLESS attr.instance %]
my [% attr.loc %];
  [% END %]
[% END %]
    

#################################################################
# Initialization
#

 
=head2 __intialize

Initialize all slots in this Classifier.
Does not initlaize slots in Generalizations.

See also: C<_initialize>.

=cut
sub __initialize
{
  my ($self) = @_;

  # Attributes

[% FOREACH attr = cls.attribute %]
  [% IF attr.instance %]
  # Attribute [% attr.name %]

  if ( exists [% attr.loc %] ) {
    my $x = [% attr.loc %];
    [% attr.loc %] = undef;
    $self->set_[% attr.name %]($x);
  } else {
    [% IF attr.initialValue_defined %]
    [% attr.loc %] = [% attr.initialValue %];
    [% END %]
  }
  [% ELSE %]
  [% attr.loc %] = undef unless exists [% attr.loc %];
  [% END %]

[% END %]


  # Associations

[% FOREACH cls_end = cls.association %]
[% FOREACH end = cls_end.opposite %]
[% NEXT UNLESS end.isNavigable %]
  # AssociationEnd 
  #  [% cls_end.name %] [% cls_end.multi %] 

  #  <--> 
  #  [% end.name %] [% end.multi %] [% end.type %].
  [% IF end.multi_single %]
  if ( defined [% end.loc %] ) {
    my $x = [% end.loc %];
    [% end.loc %] = undef;
    $self->set_[% end.name %]($x);
  }
  [% ELSE %]
  if ( defined [% end.loc %] && @{[% end.loc %]} ) {
    my $x = [% end.loc %];
    [% end.loc %] = [ ];
    $self->set_[% end.name %](@$x);
  }
  [% END %]

[% END %]
[% END %]

  $self;
}


my $__initialize_use;

=head2 _intialize

Initialize all slots in this Classifier and all Generalizations.

See also: C<__initialize>.

=cut
sub _initialize
{
  my ($self) = @_;

  # $DB::single = 1;

  unless ( ! $__initialize_use ) {
    $__initialize_use = 1;
[% FOREACH super = cls.generalization_all %]
    $self->__use('[% super.package %]');
[% END %]
  }

  $self->[% cls.package %]::__initialize;
[% FOREACH super = cls.generalization_all %]
  $self->[% super.package %]::__initialize;
[% END %]

  $self;
}
      

#################################################################
# Attributes
#


[% FOREACH attr = cls.attribute %]

#################################################################
# Attribute [% attr.name %]

# type = [% attr.type %] 

# multiplicity = [% attr.multi %] 


[% IF attr.multi_single %]
=head2 [% attr.name %]


  my $val = $obj->[% attr.name %];

Returns the value of Attribute [% attr.name %].

=cut
sub [% attr.name %] ($)
{
  my ($self) = @_;

  [% attr.loc %];
}


=head2 set_[% attr.name %]


  $obj->set_[% attr.name %]($val);

Sets the value of Attribute [% attr.name %].
C<$val> must be of type C<[% attr.type %]>.
Returns C<$obj>.

=cut
sub set_[% attr.name %] ($$)
{
  my ($self, $val) = @_;

  [% attr.typecheck %];

  [% attr.loc %] = $val;

  $self
}
[% ELSE %]
=head2 [% attr.name %]


  my $array_ref = $obj->[% attr.name %];
  my @val = $obj->[% attr.name %];

Returns the values of Attribute [% attr.name %].
In list context it returns the list of values.
In scalar context it returns a reference to the list of values.

=cut
sub [% attr.name %] ($)
{
  my ($self) = @_;

  my $x = [% attr.loc %] ||= [ ];

  wantarray ? @$x : $x;
}


=head2 set_[% attr.name %]


  $obj->set_[% attr.name %](@val);

Sets the value of Attribute [% attr.name %].
The elements of C<@val> must be of type C<[% attr.type %]>.
Returns C<$obj>.

=cut
sub set_[% attr.name %] ($@)
{
  my ($self, @val) = @_;

  for my $val ( @val ) { 
    [% attr.typecheck %];
  }
  
  [% attr.loc %] = \@val;

  $self;
}


=head2 add_[% attr.name %]


  $obj->add_[% attr.name %](@val);

Adds the values of Attribute [% attr.name %].
The elements of C<@val> must be of type C<[% attr.type %]>.
Returns C<$obj>.

=cut
sub add_[% attr.name %] ($@)
{
  my ($self, @val) = @_;

  for my $val ( @val ) { 
    [% attr.typecheck %];
  }
  
  push(@{[% attr.loc %] ||= [ ]}, @val);

  $self;
}


=head2 remove_[% attr.name %]


  $obj->remove_[% attr.name %](@val);

Removes values from Attribute [% attr.name %].
The elements of C<@val> must be of type C<[% attr.type %]>.
Returns C<$obj>.

=cut
sub remove_[% attr.name %] ($@)
{
  my ($self, @val) = @_;

  for my $val ( @val ) { 
    [% attr.typecheck %];
  }

  my $x = [% attr.loc %] ||= [ ];
  for my $val ( @val ) {
   @$x = grep($_ ne $val, @$x);
  }

  $self;
}


=head2 clear_[% attr.name %]


  $obj->clear_[% attr.name %];

Removes all values from Attribute [% attr.name %].
Returns C<$obj>.

=cut
sub clear_[% attr.name %] ($)
{
  my ($self) = @_;

  [% attr.loc %] = [ ];
	      
  $self;
}

[% END %]
[% END %]


#################################################################
# Association
#

[% FOREACH cls_end = cls.association %]
[% FOREACH end = cls_end.opposite %]
[% NEXT UNLESS end.isNavigable %]

#################################################################
# AssociationEnd [% cls_end.name %] => [% end.name %]

# type = [% end.type %]

# multiplicity = [% end.multi %]

[% IF end.multi_single %]

=head2 [% end.name %]


  my $val = $obj->[% end.name %];

Returns the AssociationEnd value of type C<[% end.type %]>.

=cut
sub [% end.name %] ($)
{
  my ($self) = @_;
		  
  [% end.loc %];
}


=head2 set_[% end.name %]


  $obj->set_[% end.name %]($val);

Sets the AssociationEnd value.
C<$val> must of of type C<[% end.type %]>.
Returns C<$obj>.

=cut
sub set_[% end.name %] ($$)
{
  my ($self, $val) = @_;
		  
  no warnings; # Use of uninitialized value in string ne at ...
		  
  my $old;
  if ( ($old = [% end.loc %]) ne $val ) { # Recursion lock

    [% end.typecheck %];

    [% end.loc %] = $val;                 # Recursion lock
    # Remove and add associations with other ends.
    [% other(end=end) %]
  }
		  
  $self;
}


=head2 add_[% end.name %]


  $obj->add_[% end.name %]($val);

Adds the AssociationEnd value.
C<$val> must of of type C<[% end.type %]>.
Throws exception if a value already exists.
Returns C<$obj>.

=cut
sub add_[% end.name %] ($$)
{
  my ($self, $val) = @_;

  no warnings; # Use of uninitialized value in string ne at ...

  my $old;
  if ( ($old = [% end.loc %]) ne $val ) { # Recursion lock
    [% end.typecheck %];
      
    # confess("[% cls.package %]::[% end.name %]: too many")
    # if defined [% end.loc %];

    [% end.loc %] = $val;                 # Recursion lock

    # Remove and add associations with other ends.
    [% other(end=end) %]

  }

  $self;
}


=head2 remove_[% end.name %]


  $obj->remove_[% end.name %]($val);

Removes the Association to C<$val>.
Returns C<$obj>.

=cut
sub remove_[% end.name %] ($$)
{
  my ($self, $val) = @_;

  no warnings; # Use of uninitialized value in string ne at ...

  my $old;
  if ( ($old = [% end.loc %]) eq $val ) { # Recursion lock
    $val = [% end.loc %] = undef;         # Recursion lock

    # Remove and add associations with other ends.
    [% other(end=end) %]

  }
}


=head2 clear_[% end.name %]


  $obj->clear_[% end.name %];

Clears the Association.
Returns C<$obj>.

=cut
sub clear_[% end.name %] ($@)
{
  my ($self) = @_;

  my $old;
  if ( defined ($old = [% end.loc %]) ) { # Recursion lock
    my $val = [% end.loc %] = undef;      # Recursion lock

    # Remove and add associations with other ends.
    [% other(end=end) %]

  }

  $self;
}


[% ELSE %]

=head2 [% end.name %]


  my @val = $obj->[% end.name %];
  my $ary_val = $obj->[% end.name %];

Returns the AssociationEnd value.
In array context, returns all the objects in the Association.
In scalar context, returns an array ref of all the objects in the Association.

=cut
sub [% end.name %] ($)
{
  my ($self) = @_;
		  
  my $x = [% end.loc %] ||= [ ];
  wantarray ? @{$x} : $x;
}


=head2 set_[% end.name %]


  $obj->set_[% end.name %](@val);

Sets the AssociationEnd value.
Elements of C<@val> must of of type C<[% end.type %]>.
Returns C<$obj>.

=cut
sub set_[% end.name %] ($@)
{
  my ($self, @val) = @_;
  
  $self->clear_[% end.name %];
  $self->add_[% end.name %](@val);
}


=head2 add_[% end.name %]


  $obj->add_[% end.name %](@val);

Sets the AssociationEnd value.
Elements of C<@val> must of of type C<[% end.type %]>.
Returns C<$obj>.

=cut
sub add_[% end.name %] ($@)
{
  my ($self, @val) = @_;
  
  my $x = [% end.loc %] ||= [ ];
  my $old; # Place holder for other MACRO.
  
  for my $val ( @val ) {
    next if grep($_ eq $val, @$x);   # Recursion lock
    [% end.typecheck %];

    push(@{$x}, $val);               # Recursion lock

    # Remove and add associations with other ends.
    [% other(end=end) %]

  }
  
  $self;
}


=head2 remove_[% end.name %]


  $obj->remove_[% end.name %]($val);

Removes the Association to C<$val>.
Returns C<$obj>.

=cut
sub remove_[% end.name %] ($@)
{
  my ($self, @val) = @_;
  
  my $x = [% end.loc %] ||= [ ];
  
  for my $old ( @val ) {
    next unless grep($_ eq $old, @$x); # Recursion lock
    my $val = $old;
      
    [% end.typecheck %];

    @$x = grep($_ ne $old, @$x);       # Recursion lock
    $val = undef;

    # Remove associations with other ends.

    [% other(end=end) %];

  }
  
  $self;
}


=head2 clear_[% end.name %]


  $obj->clear_[% end.name %];

Clears the Association.
Returns C<$obj>.

=cut
sub clear_[% end.name %] ($) 
{
  my ($self) = @_;
  
  my $x = [% end.loc %] ||= [ ];
  my $val; # Place holder for other MACRO.
  
  [% end.loc %] = [ ];  # Recursion lock
  for my $old ( @$x ) { # Recursion lock

    # Remove associations with other ends.

    [% other(end=end) %];

  }
  
  $self;
}
[% END %]

[% END %]
[% END %]



############################################################################

1; # is true!

############################################################################

### Keep these comments at end of file: ks.perl@kurtstephens.com 2003/04/06 ###
### Local Variables: ###
### mode:perl ###
### perl-indent-level:2 ###
### perl-continued-statement-offset:0 ###
### perl-brace-offset:0 ###
### perl-label-offset:0 ###
### End: ###

#//-// FILE END [% cls.package_file %]
[% END %]

############################################################################

### Keep these comments at end of file: ks.perl@kurtstephens.com 2003/04/06 ###
### Local Variables: ###
### mode:perl ###
### perl-indent-level:2 ###
### perl-continued-statement-offset:0 ###
### perl-brace-offset:0 ###
### perl-label-offset:0 ###
### End: ###