File Coverage

blib/lib/Sort/Array.pm

Criterion	Covered	Total	%
statement	6	99	6.0
branch	0	50	0.0
condition	0	12	0.0
subroutine	2	4	50.0
pod	0	2	0.0
total	8	167	4.7

# Sort::Array.pm
#
# Copyright (c) 2001 Michael Diekmann . All rights
# reserved. This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

# Documentation could be found at the bottom or use (after install):
# > perldoc Sort::Array

package Sort::Array;

require 5.003_03;
require Exporter;

use strict;
use vars qw(@EXPORT_OK @ISA $VERSION $error);
@ISA = qw(Exporter);

# we export nothing by default :)
@EXPORT_OK = qw(
	Sort_Table
	Discard_Duplicates
);

$VERSION = '0.26';

#///////////////////////////////////////////////////////////////////////#
#									#
#///////////////////////////////////////////////////////////////////////#

sub Discard_Duplicates {
	# Get the args and put them into a Hash.
    	my (%arg) = @_;
	$error = 0;

	# Check for content that should be sorted,
	# else return error-code.
	if (scalar(@{$arg{data}}) == 0) {
		$error = 104;
		return undef;
	}

	my $use_warn = 0;
	# Turn warnings off, because we do first a '<=>' and if that
	# fails, we do a 'cmp'. And then a warning comes up.
	# After working, we turn $^W to the same as before.
	if ($^W) {
		$use_warn = $^W;
		$^W = 0;
	}

	# Find duplicates and sort them out.
	my %seen = ();
	my @unique = grep { ! $seen{$_}++ } @{$arg{data}};
	%seen = ();

	# Check if  is set, if empty do not sort them.
	if ($arg{sorting} eq 'ascending') {
		# Sorting content ascending order.
		@unique = sort { $a <=> $b || $a cmp $b } @unique;
	}
	elsif ($arg{sorting} eq 'descending') {
		# Sorting content descending order.
		@unique = sort { $b <=> $a || $b cmp $a } @unique;
	}

	# Turn warnings to the same as before.
	if ($use_warn) {
		$^W = $use_warn;
	}

	# Remove all empty fields, if wished.
	if ($arg{empty_fields} eq 'delete') {
		@_ = ();
		foreach (@unique) {
			push(@_, $_) if $_;
		}
		@unique = @_;
	}
#	return @unique;
	@{$arg{data}} = @unique;
}

#///////////////////////////////////////////////////////////////////////#
#									#
#///////////////////////////////////////////////////////////////////////#

sub Sort_Table {
	# Get the args and put them into a Hash.
    	my (%arg) = @_;
	$error = 0;

	# Check if  is set,
	# else return error-code.
	if ((! $arg{cols}) && ($arg{cols} !~ /0-9/)) {
		$error = 100;
		return undef;
	}

	# Check if  is set,
	# else return error-code.
	if ((! $arg{field}) && ($arg{field} !~ /0-9/)) {
		$error = 101;
		return undef;
	}

	# Check if  is set,
	# else return error-code.
	if ((! $arg{sorting}) && (($arg{sorting} ne 'ascending') || ($arg{sorting} ne 'descending'))) {
		$error = 102;
		return undef;
	}

	# Check if  set,
	# else return error-code.
	if (! $arg{structure}) {
		$error = 103;
		return undef;
	}

	# Check for content that should be sorted,
	# else return error-code.
	if (scalar(@{$arg{data}}) == 0) {
		$error = 104;
		return undef;
	}

	# Check is  set,
	# else set the standard > ";"
	if (! $arg{separator}) {
		$arg{separator} = ';';
	}

	# Subtract 1 for better readable Arrayfields ->
	# beginning count at 1 (not 0). ;)
	$arg{cols}--;
	$arg{field}--;

	if ($arg{structure} eq 'single') {
		# Array is not semicolon-separated and we must
		# convert it to semicolon-separated.
		@_ = ();
		my $i=0;
		while (defined ${$arg{data}}[$i] ne '') {
			my $tmp='';
			for (0..$arg{cols}) {
				$tmp .= "${$arg{data}}[$i+$_]";
				if ($_ != $arg{cols}) {
					$tmp .= "$arg{separator}";
				}
			}
			push(@_, $tmp);
			$i += $arg{cols} + 1;
		}
		@{$arg{data}} = @_;
	}

	my $use_warn = 0;
	# Turn warnings off, because we do first a '<=>' and if that
	# fails, we do a 'cmp' and then a warning comes up.
	# After sorting, we turn $^W to the same as before.
	if ($^W) {
		$use_warn = $^W;
		$^W = 0;
	}
	if ($arg{sorting} eq 'ascending') {
		# Sorting content ascending order.
		@{$arg{data}} =
			map { $_->[0] }
			sort {
				$a->[1] <=> $b->[1]
					||
				$a->[1] cmp $b->[1]
			}
			map { [ $_, (split(/$arg{separator}/))[$arg{field}] ] }
		@{$arg{data}};
	}
	elsif ($arg{sorting} eq 'descending') {
		# Sorting content descending order.
		@{$arg{data}} =
			map { $_->[0] }
			sort {
				$b->[1] <=> $a->[1]
					||
				$b->[1] cmp $a->[1]
			}
			map { [ $_, (split(/$arg{separator}/))[$arg{field}] ] }
		@{$arg{data}};
	}

	# Turn warnings to the same as before.
	if ($use_warn) {
		$^W = $use_warn;
	}

	# Return the sorted Array in the
	# same format as input.
	if ($arg{structure} eq 'csv') {
		return @{$arg{data}};
	}
	elsif ($arg{structure} eq 'single') {
		@_ = ();
		foreach (@{$arg{data}}) {
			push(@_, split(/$arg{separator}/));
		}
		return @_;
	}
}

1;

__END__