use Carp;
use strict;
our $VERSION = sprintf "%d.%02d", q$Revision: 1.1.1.1 $ =~ /: (\d+)\.(\d+)/;
sub new {
my $class = shift;
my %opt = @_;
my $self = bless {}, $class;
$self->prefix('#');
$self->number_length(1);
return $self;
}
sub prefix {
my $self = shift;
my $prefix = shift;
if ( defined $prefix ){
$self->{_PREFIX} = $prefix;
}
return $self->{_PREFIX};
}
sub number_length {
my $self = shift;
my $length = shift;
if ( defined $length ){
$self->{_NUMBER_LENGTH} = int $length;
}
return $self->{_NUMBER_LENGTH};
}
sub from_string {
my $self = shift;
my $string = shift;
my @items = split( /\,/, $string );
my @data;
foreach my $item ( @items ) {
if ( $item =~ /\-/ ){
my ( $from, $to ) = split( /\-/, $item );
# push @data, [ $self->_string2number($from), $self->_string2number($to) ];
foreach ( $self->_string2number($from) .. $self->_string2number($to) ){
push @data, $_ ;
}
}else{
push @data, $self->_string2number($item);
}
}
return ( wantarray ) ? @data : \@data;
}
sub from_list {
my $self = shift;
my $array_ref = ( ref $_[0] eq 'ARRAY' ) ? $_[0] : [@_] ;
my @ln = sort { $a <=> $b } @$array_ref;
my @scope;
my $start = undef;
my $end = undef;
foreach (0..$#ln){
if ( not defined $start ){
$start = $_;
$end = $_;
}else{
# Êý×Ö²»Á¬Ðø£¬Ôò±íÃ÷µ±Ç°Î»ÖÃΪжεĿªÊ¼£¬
# ËùÒÔ½«Ö®Ç°½áÊøµÄ¶Î±£´æµ½»º´æÖÐ
# ²¢µ±Ç°Î»Öñ£ÁôΪжÎÊý¾Ý
if ( $ln[$_] != $ln[$_-1] + 1 ){
$end = $_ - 1;
push @scope, [$start,$end];
$start = $_;
$end = $_;
}
# Èç¹ûÕâ´ÎÒѾ­ÊÇ×îºóÒ»¸ö £¨Á¬ÐøÊý×ֶεÄ×îºóÒ»¸ö£¬»òÕßжεĵÚÒ»¸ö£©
# ¶¼Ö»Òª°ÑËûÃDZ£´æµ½»º´æ¼´¿É
if ( $_ == $#ln ){
$end = $_;
push @scope, [$start,$end];
}
}
}
my $string = join( ',',
map {
( $$_[0] == $$_[1] )
? $self->_number2string($ln[$$_[0]])
: join( '-', ( $self->_number2string($ln[$$_[0]]),
$self->_number2string($ln[$$_[1]], without_prefix => 1 ) )
);
} @scope
);
return $string;
}
sub _string2number {
my $self = shift;
my $string = shift;
my $prefix = $self->prefix;
$string =~ s/^$prefix//e;
my $number = int( $string + 0 );
return $number;
}
sub _number2string {
my $self = shift;
my $number = shift;
my %opt = @_;
my $prefix = $self->prefix;
my $length = $self->number_length;
my $string = join ('',
( $opt{'without_prefix'} ) ? '' : $prefix,
sprintf("%0".$length."d", $number)
);
return $string;
}
1;
__END__
=head1 NAME
SerialNumber::Sequence - make continously serial number sequence to be readable string; and vice verser;
=head1 SYNOPSIS
use SerialNumber::Sequence;
my $ss = new SerialNumber::Sequence;
my $sequence = [23,24,25,26,34,35,36,45,46,79,88];
$ss->number_length(3);
my $string = $ss->from_list( $sequence ); # return '#023-026,#034-036,#045-046,#079,#088'
my @array = $ss->from_string( $string ); # return [23,24,25,26,34,35,36,45,46,79,88]
=head1 DESCRIPTION
Some bill of document has its serialnumber, almostly are continuously. In some situation, we wanner do somthing with a group of these bills, which serial number are not continuously sequence, like this: [23,24,25,26,34,35,36,45,46,79,88], it is not readable for a person, when we print these infomation on invoice, we wanner a readable string to represent that sequence, which should be more short and clearly. So use this module and it will give a string: '#23-26,#34-36,#45-46,#79,#88' according above, of course we supply a method to do reverse-thing.
the prefix '#' and number length can be customized.
=head1 METHODS
=item new()
my $ss = new SerialNumber::Sequence;
It's very simple. just copy and paste that.
=item prefix()
# set/get prefix
$ss->prefix('@'); # set serialnumber prefix as '@'
$ss->prefix(); # return '@'
Default is '#'.
=item number_length()
# set/get number_length
$ss->number_length(5); # set serialnumber as 5 length number, with prefix '0'
$ss->number_length(); # return 5;
Default is 1. If serial number is 45567 and set number length to be 8, then after transform, you will get #00045567
=item from_list(@array)
my $string = $ss->from_list( $array_ref_of_a_sequence );
my $string = $ss->from_list( @array_of_a_sequence );
give a sequence with array or array ref, and return the readable string.
=item from_string($string)
my @array = $ss->from_string( $string );
my $array_ref = $ss->from_string( $string );
give some string like above method returned, return the array which elements are the pure serial number( without prefix string ).
=item _string2number()
private method, transform a single string to a number
=item _number2string()
$self->_number2string($number, without_prefix => 1 );
private method, transform a single number to a string, if without_prefix => 1, then ignore '#';
=head1 TODO
some more other transform style; some caculation for some sequence plus or minus operation;
=head1 AUTHOR
Chun Sheng <me@chunzi.org>
=head1 COPYRIGHT
Copyright (c) 2004-2005 Chun Sheng. All rights reserved. All wrongs revenged. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut