[gitmo/Moose.git] / lib / Moose / Meta / Attribute / Native / MethodProvider / Array.pm

package Moose::Meta::Attribute::Native::MethodProvider::Array;
use Moose::Role;

use List::Util;
use List::MoreUtils;

our $VERSION = '0.95';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';

sub count : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        scalar @{ $reader->( $_[0] ) };
    };
}

sub is_empty : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        scalar @{ $reader->( $_[0] ) } ? 0 : 1;
    };
}

sub first : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        my ( $instance, $predicate ) = @_;
        List::Util::first { $predicate->() } @{ $reader->($instance) };
    };
}

sub map : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        my ( $instance, $f ) = @_;
        CORE::map { $f->() } @{ $reader->($instance) };
    };
}

sub reduce : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        my ( $instance, $f ) = @_;
        our ($a, $b);
        List::Util::reduce { $f->($a, $b) } @{ $reader->($instance) };
    };
}

sub sort : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        my ( $instance, $predicate ) = @_;
        die "Argument must be a code reference"
          if $predicate && ref $predicate ne 'CODE';

        if ($predicate) {
            # Although it would be nice if we could support just using $a and
            # $b like sort already does, using $a or $b once in a package
            # triggers the 'Name "main::a" used only once' warning, and there
            # is no good way to avoid that, since it happens when the file
            # which defines the coderef is compiled, before we even get a
            # chance to see it here. So, we have no real choice but to use
            # normal parameters. --doy
            CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
        }
        else {
            CORE::sort @{ $reader->($instance) };
        }
    };
}

sub shuffle : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        my ( $instance ) = @_;
        List::Util::shuffle @{ $reader->($instance) };
    };
}

sub grep : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        my ( $instance, $predicate ) = @_;
        CORE::grep { $predicate->() } @{ $reader->($instance) };
    };
}

sub uniq : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        my ( $instance ) = @_;
        List::MoreUtils::uniq @{ $reader->($instance) };
    };
}

sub elements : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        my ($instance) = @_;
        @{ $reader->($instance) };
    };
}

sub join : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        my ( $instance, $separator ) = @_;
        join $separator, @{ $reader->($instance) };
    };
}

sub push : method {
    my ( $attr, $reader, $writer ) = @_;

    if (
        $attr->has_type_constraint
        && $attr->type_constraint->isa(
            'Moose::Meta::TypeConstraint::Parameterized')
      )
    {
        my $container_type_constraint = $attr->type_constraint->type_parameter;
        return sub {
            my $instance = CORE::shift;
            $container_type_constraint->check($_)
              || confess "Value "
              . ( $_ || 'undef' )
              . " did not pass container type constraint '$container_type_constraint'"
              foreach @_;
            CORE::push @{ $reader->($instance) } => @_;
        };
    }
    else {
        return sub {
            my $instance = CORE::shift;
            CORE::push @{ $reader->($instance) } => @_;
        };
    }
}

sub pop : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        CORE::pop @{ $reader->( $_[0] ) };
    };
}

sub unshift : method {
    my ( $attr, $reader, $writer ) = @_;
    if (
        $attr->has_type_constraint
        && $attr->type_constraint->isa(
            'Moose::Meta::TypeConstraint::Parameterized')
      )
    {
        my $container_type_constraint = $attr->type_constraint->type_parameter;
        return sub {
            my $instance = CORE::shift;
            $container_type_constraint->check($_)
              || confess "Value "
              . ( $_ || 'undef' )
              . " did not pass container type constraint '$container_type_constraint'"
              foreach @_;
            CORE::unshift @{ $reader->($instance) } => @_;
        };
    }
    else {
        return sub {
            my $instance = CORE::shift;
            CORE::unshift @{ $reader->($instance) } => @_;
        };
    }
}

sub shift : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        CORE::shift @{ $reader->( $_[0] ) };
    };
}

sub get : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        $reader->( $_[0] )->[ $_[1] ];
    };
}

sub set : method {
    my ( $attr, $reader, $writer ) = @_;
    if (
        $attr->has_type_constraint
        && $attr->type_constraint->isa(
            'Moose::Meta::TypeConstraint::Parameterized')
      )
    {
        my $container_type_constraint = $attr->type_constraint->type_parameter;
        return sub {
            ( $container_type_constraint->check( $_[2] ) )
              || confess "Value "
              . ( $_[2] || 'undef' )
              . " did not pass container type constraint '$container_type_constraint'";
            $reader->( $_[0] )->[ $_[1] ] = $_[2];
        };
    }
    else {
        return sub {
            $reader->( $_[0] )->[ $_[1] ] = $_[2];
        };
    }
}

sub accessor : method {
    my ( $attr, $reader, $writer ) = @_;

    if (
        $attr->has_type_constraint
        && $attr->type_constraint->isa(
            'Moose::Meta::TypeConstraint::Parameterized')
      )
    {
        my $container_type_constraint = $attr->type_constraint->type_parameter;
        return sub {
            my $self = shift;

            if ( @_ == 1 ) {    # reader
                return $reader->($self)->[ $_[0] ];
            }
            elsif ( @_ == 2 ) {    # writer
                ( $container_type_constraint->check( $_[1] ) )
                  || confess "Value "
                  . ( $_[1] || 'undef' )
                  . " did not pass container type constraint '$container_type_constraint'";
                $reader->($self)->[ $_[0] ] = $_[1];
            }
            else {
                confess "One or two arguments expected, not " . @_;
            }
        };
    }
    else {
        return sub {
            my $self = shift;

            if ( @_ == 1 ) {    # reader
                return $reader->($self)->[ $_[0] ];
            }
            elsif ( @_ == 2 ) {    # writer
                $reader->($self)->[ $_[0] ] = $_[1];
            }
            else {
                confess "One or two arguments expected, not " . @_;
            }
        };
    }
}

sub clear : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        @{ $reader->( $_[0] ) } = ();
    };
}

sub delete : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        CORE::splice @{ $reader->( $_[0] ) }, $_[1], 1;
      }
}

sub insert : method {
    my ( $attr, $reader, $writer ) = @_;
    if (
        $attr->has_type_constraint
        && $attr->type_constraint->isa(
            'Moose::Meta::TypeConstraint::Parameterized')
      )
    {
        my $container_type_constraint = $attr->type_constraint->type_parameter;
        return sub {
            ( $container_type_constraint->check( $_[2] ) )
              || confess "Value "
              . ( $_[2] || 'undef' )
              . " did not pass container type constraint '$container_type_constraint'";
            CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
        };
    }
    else {
        return sub {
            CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
        };
    }
}

sub splice : method {
    my ( $attr, $reader, $writer ) = @_;
    if (
        $attr->has_type_constraint
        && $attr->type_constraint->isa(
            'Moose::Meta::TypeConstraint::Parameterized')
      )
    {
        my $container_type_constraint = $attr->type_constraint->type_parameter;
        return sub {
            my ( $self, $i, $j, @elems ) = @_;
            ( $container_type_constraint->check($_) )
              || confess "Value "
              . ( defined($_) ? $_ : 'undef' )
              . " did not pass container type constraint '$container_type_constraint'"
              for @elems;
            CORE::splice @{ $reader->($self) }, $i, $j, @elems;
        };
    }
    else {
        return sub {
            my ( $self, $i, $j, @elems ) = @_;
            CORE::splice @{ $reader->($self) }, $i, $j, @elems;
        };
    }
}

sub sort_in_place : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        my ( $instance, $predicate ) = @_;

        die "Argument must be a code reference"
          if $predicate && ref $predicate ne 'CODE';

        my @sorted;
        if ($predicate) {
            @sorted =
              CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
        }
        else {
            @sorted = CORE::sort @{ $reader->($instance) };
        }

        $writer->( $instance, \@sorted );
    };
}

sub natatime : method {
    my ( $attr, $reader, $writer ) = @_;
    return sub {
        my ( $instance, $n, $f ) = @_;
        my $it = List::MoreUtils::natatime($n, @{ $reader->($instance) });
        if ($f) {
            while (my @vals = $it->()) {
                $f->(@vals);
            }
        }
        $it;
    };
}

1;

__END__

=pod

=head1 NAME

Moose::Meta::Attribute::Native::MethodProvider::Array

=head1 DESCRIPTION

This is a role which provides the method generators for
L<Moose::Meta::Attribute::Native::Trait::Array>. Please check there for
documentation on what methods are provided.

=head1 METHODS

=over 4

=item B<meta>

=back

=head1 BUGS

See L<Moose/BUGS> for details on reporting bugs.

=head1 AUTHOR

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2007-2009 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
Commit	Line	Data
c466e58f	1	package Moose::Meta::Attribute::Native::MethodProvider::Array;
e3c07b19	2	use Moose::Role;
e3c07b19	3
7960bcc0	4	use List::Util;
	5	use List::MoreUtils;
	6
b7ef2be4	7	our $VERSION = '0.95';
e3c07b19	8	$VERSION = eval $VERSION;
	9	our $AUTHORITY = 'cpan:STEVAN';
	10
e11fb12c	11	sub count : method {
	12	my ( $attr, $reader, $writer ) = @_;
	13	return sub {
	14	scalar @{ $reader->( $_[0] ) };
	15	};
	16	}
	17
1853a27e	18	sub is_empty : method {
e11fb12c	19	my ( $attr, $reader, $writer ) = @_;
e11fb12c	20	return sub {
af44c00c	21	scalar @{ $reader->( $_[0] ) } ? 0 : 1;
e11fb12c	22	};
	23	}
	24
391c761c	25	sub first : method {
e11fb12c	26	my ( $attr, $reader, $writer ) = @_;
	27	return sub {
	28	my ( $instance, $predicate ) = @_;
31c519ab	29	List::Util::first { $predicate->() } @{ $reader->($instance) };
e11fb12c	30	};
	31	}
	32
	33	sub map : method {
	34	my ( $attr, $reader, $writer ) = @_;
	35	return sub {
	36	my ( $instance, $f ) = @_;
c9edbf05	37	CORE::map { $f->() } @{ $reader->($instance) };
e11fb12c	38	};
	39	}
	40
7960bcc0	41	sub reduce : method {
	42	my ( $attr, $reader, $writer ) = @_;
	43	return sub {
	44	my ( $instance, $f ) = @_;
	45	our ($a, $b);
	46	List::Util::reduce { $f->($a, $b) } @{ $reader->($instance) };
	47	};
	48	}
	49
e11fb12c	50	sub sort : method {
	51	my ( $attr, $reader, $writer ) = @_;
	52	return sub {
	53	my ( $instance, $predicate ) = @_;
	54	die "Argument must be a code reference"
33f819e1	55	if $predicate && ref $predicate ne 'CODE';
e11fb12c	56
e11fb12c	57	if ($predicate) {
a163f54f	58	# Although it would be nice if we could support just using $a and
	59	# $b like sort already does, using $a or $b once in a package
	60	# triggers the 'Name "main::a" used only once' warning, and there
	61	# is no good way to avoid that, since it happens when the file
	62	# which defines the coderef is compiled, before we even get a
	63	# chance to see it here. So, we have no real choice but to use
	64	# normal parameters. --doy
e11fb12c	65	CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
	66	}
	67	else {
	68	CORE::sort @{ $reader->($instance) };
	69	}
	70	};
	71	}
	72
7960bcc0	73	sub shuffle : method {
	74	my ( $attr, $reader, $writer ) = @_;
	75	return sub {
	76	my ( $instance ) = @_;
	77	List::Util::shuffle @{ $reader->($instance) };
	78	};
	79	}
	80
e11fb12c	81	sub grep : method {
	82	my ( $attr, $reader, $writer ) = @_;
	83	return sub {
	84	my ( $instance, $predicate ) = @_;
c9edbf05	85	CORE::grep { $predicate->() } @{ $reader->($instance) };
e11fb12c	86	};
	87	}
	88
7960bcc0	89	sub uniq : method {
	90	my ( $attr, $reader, $writer ) = @_;
	91	return sub {
	92	my ( $instance ) = @_;
	93	List::MoreUtils::uniq @{ $reader->($instance) };
	94	};
	95	}
	96
e11fb12c	97	sub elements : method {
	98	my ( $attr, $reader, $writer ) = @_;
	99	return sub {
	100	my ($instance) = @_;
	101	@{ $reader->($instance) };
	102	};
	103	}
	104
	105	sub join : method {
	106	my ( $attr, $reader, $writer ) = @_;
	107	return sub {
	108	my ( $instance, $separator ) = @_;
	109	join $separator, @{ $reader->($instance) };
	110	};
	111	}
	112
e3c07b19	113	sub push : method {
046c8b5e	114	my ( $attr, $reader, $writer ) = @_;
	115
	116	if (
	117	$attr->has_type_constraint
	118	&& $attr->type_constraint->isa(
	119	'Moose::Meta::TypeConstraint::Parameterized')
33f819e1	120	)
	121	{
	122	my $container_type_constraint = $attr->type_constraint->type_parameter;
e3c07b19	123	return sub {
	124	my $instance = CORE::shift;
	125	$container_type_constraint->check($_)
33f819e1	126	\|\| confess "Value "
	127	. ( $_ \|\| 'undef' )
	128	. " did not pass container type constraint '$container_type_constraint'"
	129	foreach @_;
046c8b5e	130	CORE::push @{ $reader->($instance) } => @_;
e3c07b19	131	};
	132	}
	133	else {
	134	return sub {
	135	my $instance = CORE::shift;
046c8b5e	136	CORE::push @{ $reader->($instance) } => @_;
e3c07b19	137	};
	138	}
	139	}
	140
	141	sub pop : method {
046c8b5e	142	my ( $attr, $reader, $writer ) = @_;
e3c07b19	143	return sub {
046c8b5e	144	CORE::pop @{ $reader->( $_[0] ) };
e3c07b19	145	};
	146	}
	147
	148	sub unshift : method {
046c8b5e	149	my ( $attr, $reader, $writer ) = @_;
	150	if (
	151	$attr->has_type_constraint
	152	&& $attr->type_constraint->isa(
	153	'Moose::Meta::TypeConstraint::Parameterized')
33f819e1	154	)
	155	{
	156	my $container_type_constraint = $attr->type_constraint->type_parameter;
e3c07b19	157	return sub {
	158	my $instance = CORE::shift;
	159	$container_type_constraint->check($_)
33f819e1	160	\|\| confess "Value "
	161	. ( $_ \|\| 'undef' )
	162	. " did not pass container type constraint '$container_type_constraint'"
	163	foreach @_;
046c8b5e	164	CORE::unshift @{ $reader->($instance) } => @_;
e3c07b19	165	};
	166	}
	167	else {
	168	return sub {
	169	my $instance = CORE::shift;
046c8b5e	170	CORE::unshift @{ $reader->($instance) } => @_;
e3c07b19	171	};
	172	}
	173	}
	174
	175	sub shift : method {
046c8b5e	176	my ( $attr, $reader, $writer ) = @_;
e3c07b19	177	return sub {
046c8b5e	178	CORE::shift @{ $reader->( $_[0] ) };
e3c07b19	179	};
	180	}
	181
	182	sub get : method {
046c8b5e	183	my ( $attr, $reader, $writer ) = @_;
e3c07b19	184	return sub {
046c8b5e	185	$reader->( $_[0] )->[ $_[1] ];
e3c07b19	186	};
	187	}
	188
	189	sub set : method {
046c8b5e	190	my ( $attr, $reader, $writer ) = @_;
	191	if (
	192	$attr->has_type_constraint
	193	&& $attr->type_constraint->isa(
	194	'Moose::Meta::TypeConstraint::Parameterized')
33f819e1	195	)
	196	{
	197	my $container_type_constraint = $attr->type_constraint->type_parameter;
e3c07b19	198	return sub {
046c8b5e	199	( $container_type_constraint->check( $_[2] ) )
33f819e1	200	\|\| confess "Value "
	201	. ( $_[2] \|\| 'undef' )
	202	. " did not pass container type constraint '$container_type_constraint'";
046c8b5e	203	$reader->( $_[0] )->[ $_[1] ] = $_[2];
e3c07b19	204	};
	205	}
	206	else {
	207	return sub {
046c8b5e	208	$reader->( $_[0] )->[ $_[1] ] = $_[2];
e3c07b19	209	};
	210	}
	211	}
	212
	213	sub accessor : method {
046c8b5e	214	my ( $attr, $reader, $writer ) = @_;
	215
	216	if (
	217	$attr->has_type_constraint
	218	&& $attr->type_constraint->isa(
	219	'Moose::Meta::TypeConstraint::Parameterized')
33f819e1	220	)
	221	{
	222	my $container_type_constraint = $attr->type_constraint->type_parameter;
e3c07b19	223	return sub {
	224	my $self = shift;
	225
046c8b5e	226	if ( @_ == 1 ) { # reader
046c8b5e	227	return $reader->($self)->[ $_[0] ];
e3c07b19	228	}
046c8b5e	229	elsif ( @_ == 2 ) { # writer
046c8b5e	230	( $container_type_constraint->check( $_[1] ) )
33f819e1	231	\|\| confess "Value "
	232	. ( $_[1] \|\| 'undef' )
	233	. " did not pass container type constraint '$container_type_constraint'";
046c8b5e	234	$reader->($self)->[ $_[0] ] = $_[1];
e3c07b19	235	}
	236	else {
	237	confess "One or two arguments expected, not " . @_;
	238	}
	239	};
	240	}
	241	else {
	242	return sub {
	243	my $self = shift;
	244
046c8b5e	245	if ( @_ == 1 ) { # reader
046c8b5e	246	return $reader->($self)->[ $_[0] ];
e3c07b19	247	}
046c8b5e	248	elsif ( @_ == 2 ) { # writer
046c8b5e	249	$reader->($self)->[ $_[0] ] = $_[1];
e3c07b19	250	}
	251	else {
	252	confess "One or two arguments expected, not " . @_;
	253	}
	254	};
	255	}
	256	}
	257
	258	sub clear : method {
046c8b5e	259	my ( $attr, $reader, $writer ) = @_;
e3c07b19	260	return sub {
046c8b5e	261	@{ $reader->( $_[0] ) } = ();
e3c07b19	262	};
	263	}
	264
	265	sub delete : method {
046c8b5e	266	my ( $attr, $reader, $writer ) = @_;
e3c07b19	267	return sub {
046c8b5e	268	CORE::splice @{ $reader->( $_[0] ) }, $_[1], 1;
33f819e1	269	}
e3c07b19	270	}
	271
	272	sub insert : method {
046c8b5e	273	my ( $attr, $reader, $writer ) = @_;
	274	if (
	275	$attr->has_type_constraint
	276	&& $attr->type_constraint->isa(
	277	'Moose::Meta::TypeConstraint::Parameterized')
33f819e1	278	)
	279	{
	280	my $container_type_constraint = $attr->type_constraint->type_parameter;
e3c07b19	281	return sub {
046c8b5e	282	( $container_type_constraint->check( $_[2] ) )
33f819e1	283	\|\| confess "Value "
	284	. ( $_[2] \|\| 'undef' )
	285	. " did not pass container type constraint '$container_type_constraint'";
046c8b5e	286	CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
e3c07b19	287	};
	288	}
	289	else {
	290	return sub {
046c8b5e	291	CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
e3c07b19	292	};
	293	}
	294	}
	295
	296	sub splice : method {
046c8b5e	297	my ( $attr, $reader, $writer ) = @_;
	298	if (
	299	$attr->has_type_constraint
	300	&& $attr->type_constraint->isa(
	301	'Moose::Meta::TypeConstraint::Parameterized')
33f819e1	302	)
	303	{
	304	my $container_type_constraint = $attr->type_constraint->type_parameter;
e3c07b19	305	return sub {
e3c07b19	306	my ( $self, $i, $j, @elems ) = @_;
046c8b5e	307	( $container_type_constraint->check($_) )
33f819e1	308	\|\| confess "Value "
	309	. ( defined($_) ? $_ : 'undef' )
	310	. " did not pass container type constraint '$container_type_constraint'"
	311	for @elems;
046c8b5e	312	CORE::splice @{ $reader->($self) }, $i, $j, @elems;
e3c07b19	313	};
	314	}
	315	else {
	316	return sub {
	317	my ( $self, $i, $j, @elems ) = @_;
046c8b5e	318	CORE::splice @{ $reader->($self) }, $i, $j, @elems;
e3c07b19	319	};
	320	}
	321	}
	322
	323	sub sort_in_place : method {
046c8b5e	324	my ( $attr, $reader, $writer ) = @_;
e3c07b19	325	return sub {
046c8b5e	326	my ( $instance, $predicate ) = @_;
e3c07b19	327
e3c07b19	328	die "Argument must be a code reference"
33f819e1	329	if $predicate && ref $predicate ne 'CODE';
e3c07b19	330
	331	my @sorted;
	332	if ($predicate) {
33f819e1	333	@sorted =
33f819e1	334	CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
e3c07b19	335	}
e3c07b19	336	else {
046c8b5e	337	@sorted = CORE::sort @{ $reader->($instance) };
e3c07b19	338	}
e3c07b19	339
046c8b5e	340	$writer->( $instance, \@sorted );
e3c07b19	341	};
	342	}
	343
7960bcc0	344	sub natatime : method {
	345	my ( $attr, $reader, $writer ) = @_;
	346	return sub {
	347	my ( $instance, $n, $f ) = @_;
	348	my $it = List::MoreUtils::natatime($n, @{ $reader->($instance) });
	349	if ($f) {
	350	while (my @vals = $it->()) {
	351	$f->(@vals);
	352	}
	353	}
	354	$it;
	355	};
	356	}
	357
e3c07b19	358	1;
	359
	360	__END__
	361
	362	=pod
	363
	364	=head1 NAME
	365
c466e58f	366	Moose::Meta::Attribute::Native::MethodProvider::Array
e3c07b19	367
	368	=head1 DESCRIPTION
	369
	370	This is a role which provides the method generators for
e22d28f2	371	L<Moose::Meta::Attribute::Native::Trait::Array>. Please check there for
9da49e13	372	documentation on what methods are provided.
e3c07b19	373
	374	=head1 METHODS
	375
	376	=over 4
	377
	378	=item B<meta>
	379
	380	=back
	381
e3c07b19	382	=head1 BUGS
e3c07b19	383
d4048ef3	384	See L<Moose/BUGS> for details on reporting bugs.
e3c07b19	385
	386	=head1 AUTHOR
	387
	388	Stevan Little E<lt>stevan@iinteractive.comE<gt>
	389
	390	=head1 COPYRIGHT AND LICENSE
	391
	392	Copyright 2007-2009 by Infinity Interactive, Inc.
	393
	394	L<http://www.iinteractive.com>
	395
	396	This library is free software; you can redistribute it and/or modify
	397	it under the same terms as Perl itself.
	398
	399	=cut