{
$Biblio::SICI::ItemSegment::VERSION
=
'0.03'
;
}
use
5.010001;
has
'issn'
=> (
is
=>
'rw'
,
trigger
=> 1,
predicate
=> 1,
clearer
=> 1, );
sub
_trigger_issn {
my
(
$self
,
$newVal
) =
@_
;
my
@problems
= ();
if
(
$newVal
!~ m!\A[0-9X-]+\Z! ) {
push
@problems
,
'contains invalid characters'
;
}
if
(
$newVal
!~ m!\A[0-9]{4}\-[0-9]{3}[0-9X]\Z! ) {
push
@problems
,
'structural error'
;
}
unless
(
@problems
) {
if
(
my
$is
= Business::ISSN->new(
$newVal
) ) {
unless
(
$is
->is_valid ) {
push
@problems
,
'invalid issn'
;
}
}
}
if
(
@problems
) {
$self
->log_problem_on(
'issn'
=> [
@problems
] );
}
else
{
$self
->clear_problem_on(
'issn'
);
}
return
;
}
has
'chronology'
=> (
is
=>
'rw'
,
trigger
=> 1,
predicate
=> 1,
clearer
=> 1, );
sub
_trigger_chronology {
my
(
$self
,
$newVal
) =
@_
;
my
@problems
= ();
my
(
%e
) = ();
if
(
$newVal
=~ /\A[0-9]{4}\Z/ ) {
$e
{
'1Y'
} =
$newVal
;
}
elsif
(
$newVal
=~ /\A([0-9]{4})\/([0-9]{4})\Z/ ) {
$e
{
'1Y'
} = $1;
$e
{
'2Y'
} = $2;
unless
(
$e
{
'2Y'
} >
$e
{
'1Y'
} ) {
push
@problems
,
'if specified, second year must be larger than first year'
;
}
}
elsif
(
$newVal
=~ /\A([0-9]{4})([0-9]{2})\Z/ ) {
$e
{
'1Y'
} = $1;
$e
{
'1M'
} = $2;
}
elsif
(
$newVal
=~ /\A([0-9]{4})([0-9]{2})\/([0-9]{2})\Z/ ) {
$e
{
'1Y'
} = $1;
$e
{
'1M'
} = $2;
$e
{
'2M'
} = $3;
unless
(
$e
{
'2M'
} >
$e
{
'1M'
} ) {
push
@problems
,
'if specified, second month must be larger than first month'
;
}
}
elsif
(
$newVal
=~ /\A([0-9]{4})([0-9]{2})\/([0-9]{4})([0-9]{2})\Z/ ) {
$e
{
'1Y'
} = $1;
$e
{
'1M'
} = $2;
$e
{
'2Y'
} = $3;
$e
{
'2M'
} = $4;
unless
(
$e
{
'2Y'
} >
$e
{
'1Y'
} ) {
push
@problems
,
'if specified, second year must be larger than first year'
;
}
}
elsif
(
$newVal
=~ /\A([0-9]{4})([0-9]{2})([0-9]{2})\Z/ ) {
$e
{
'1Y'
} = $1;
$e
{
'1M'
} = $2;
$e
{
'1D'
} = $3;
}
elsif
(
$newVal
=~ /\A([0-9]{4})([0-9]{2})([0-9]{2})\/([0-9]{2})\Z/ ) {
$e
{
'1Y'
} = $1;
$e
{
'1M'
} = $2;
$e
{
'1D'
} = $3;
$e
{
'2D'
} = $4;
unless
(
$e
{
'2D'
} >
$e
{
'1D'
} ) {
push
@problems
,
'if specified, second day must be larger than first day'
;
}
}
elsif
(
$newVal
=~ /\A([0-9]{4})([0-9]{2})([0-9]{2})\/([0-9]{2})([0-9]{2})\Z/ ) {
$e
{
'1Y'
} = $1;
$e
{
'1M'
} = $2;
$e
{
'1D'
} = $3;
$e
{
'2M'
} = $4;
$e
{
'2D'
} = $5;
unless
(
$e
{
'2M'
} >
$e
{
'1M'
} ) {
push
@problems
,
'if specified, second month must be larger than first month'
;
}
}
elsif
(
$newVal
=~ /\A([0-9]{4})([0-9]{2})([0-9]{2})\/([0-9]{4})([0-9]{2})([0-9]{2})\Z/ ) {
$e
{
'1Y'
} = $1;
$e
{
'1M'
} = $2;
$e
{
'1D'
} = $3;
$e
{
'2Y'
} = $4;
$e
{
'2M'
} = $5;
$e
{
'2D'
} = $6;
unless
(
$e
{
'2Y'
} >
$e
{
'1Y'
} ) {
push
@problems
,
'if specified, second year must be larger than first year'
;
}
}
else
{
$self
->log_problem_on(
'chronology'
, [
'illegal chronology structure'
] );
return
;
}
my
(
@time
) =
localtime
(
time
);
my
$yr
=
$time
[5] + 1900;
my
(
undef
,
undef
,
$decade
,
$year
) =
split
(
''
,
$yr
);
if
(
$year
== 9 ) {
$year
= 0;
$decade
+= 1;
}
else
{
$year
+= 1;
}
my
$prevDecade
=
$decade
- 1;
for
(
qw( 2D 1D )
) {
if
(
exists
$e
{
$_
} and
$e
{
$_
} !~ /\A(?:[012][0-9]|3[01])\Z/ ) {
push
@problems
,
'illegal value for '
. (
$_
eq
'2D'
?
'second'
:
'first'
)
.
' day: should be 01-31'
;
}
}
for
(
qw( 2M 1M )
) {
if
(
exists
$e
{
$_
} and
$e
{
$_
} !~ /\A(?:0[0-9]|1[012]|[23][1-4])\Z/ ) {
push
@problems
,
'illegal value for '
. (
$_
eq
'2M'
?
'second'
:
'first'
)
.
' month: should be 00-12, or 21-24, or 31-34'
;
}
}
for
(
qw( 2Y 1Y )
) {
if
(
exists
$e
{
$_
}
and
$e
{
$_
} !~ /\A(?:1[0-9][0-9]{2}|20[0-
$prevDecade
][0-9]|20
$decade
[0-
$year
])\Z/o )
{
push
@problems
,
'illegal value for '
. (
$_
eq
'2Y'
?
'second'
:
'first'
) .
' year'
;
}
}
if
( !
@problems
) {
$self
->clear_problem_on(
'chronology'
);
}
else
{
$self
->log_problem_on(
'chronology'
, \
@problems
);
}
return
;
}
has
'enumeration'
=> (
is
=>
'rw'
,
predicate
=> 1,
clearer
=> 1,
trigger
=> 1, );
sub
_trigger_enumeration {
my
(
$self
,
$newVal
) =
@_
;
$self
->clear_volume();
$self
->clear_problem_on(
'volume'
);
$self
->clear_issue();
$self
->clear_problem_on(
'issue'
);
$self
->clear_supplOrIdx();
$self
->clear_problem_on(
'supplOrIdx'
);
if
(
$newVal
!~ /\A[0-9A-Z:]*[+*]?\Z/ ) {
$self
->log_problem_on(
'enumeration'
=> [
'invalid characters used'
] );
}
return
;
}
has
'volume'
=> (
is
=>
'rw'
,
predicate
=> 1,
clearer
=> 1,
trigger
=> 1, );
sub
_trigger_volume {
my
(
$self
,
$newVal
) =
@_
;
$self
->clear_enumeration();
$self
->clear_problem_on(
'enumeration'
);
my
@problems
= ();
if
(
$newVal
!~ m!\A[A-Z0-9/]+\Z! ) {
push
@problems
,
'contains invalid characters'
;
}
if
(
$newVal
!~ m!\A[A-Z0-9]+(?:/[A-Z0-9]+)?\Z! ) {
push
@problems
,
'structural error'
;
}
if
(
@problems
) {
$self
->log_problem_on(
'volume'
=> [
@problems
] );
}
else
{
$self
->clear_problem_on(
'volume'
);
}
return
;
}
has
'issue'
=> (
is
=>
'rw'
,
predicate
=> 1,
clearer
=> 1,
trigger
=> 1, );
sub
_trigger_issue {
my
(
$self
,
$newVal
) =
@_
;
$self
->clear_enumeration();
$self
->clear_problem_on(
'enumeration'
);
my
@problems
= ();
if
(
$newVal
!~ m!\A[A-Z0-9/]+\Z! ) {
push
@problems
,
'contains invalid characters'
;
}
if
(
$newVal
!~ m!\A[A-Z0-9]+(?:/[A-Z0-9]+)?\Z! ) {
push
@problems
,
'structural error'
;
}
if
(
@problems
) {
$self
->log_problem_on(
'issue'
=> [
@problems
] );
}
else
{
$self
->clear_problem_on(
'issue'
);
}
return
;
}
has
'supplOrIdx'
=> (
is
=>
'rw'
,
predicate
=> 1,
clearer
=> 1,
trigger
=> 1, );
sub
_trigger_supplOrIdx {
my
(
$self
,
$newVal
) =
@_
;
$self
->clear_enumeration();
$self
->clear_problem_on(
'enumeration'
);
my
@problems
= ();
if
(
length
$newVal
!= 1 ) {
push
@problems
,
'too many characters (allowed: 1)'
;
}
if
(
$newVal
ne
'+'
and
$newVal
ne
'*'
) {
push
@problems
,
'contains invalid characters'
;
}
if
(
@problems
) {
$self
->log_problem_on(
'supplOrIdx'
=> [
@problems
] );
}
else
{
$self
->clear_problem_on(
'supplOrIdx'
);
}
return
;
}
sub
year {
my
$self
=
shift
;
return
unless
$self
->has_chronology();
my
$c
=
$self
->chronology;
if
(
$c
=~ /\A[0-9]{4}\Z/ ) {
return
"$c"
;
}
elsif
(
$c
=~ /\A([0-9]{4})\/([0-9]{4})\Z/ ) {
return
(
"$1"
,
"$2"
);
}
elsif
(
$c
=~ /\A([0-9]{4})(?:[0-9]{2})\Z/ ) {
return
"$1"
;
}
elsif
(
$c
=~ /\A([0-9]{4})(?:[0-9]{2})\/(?:[0-9]{2})\Z/ ) {
return
"$1"
;
}
elsif
(
$c
=~ /\A([0-9]{4})(?:[0-9]{2})\/([0-9]{4})(?:[0-9]{2})\Z/ ) {
return
(
"$1"
,
"$2"
);
}
elsif
(
$c
=~ /\A([0-9]{4})(?:[0-9]{2})(?:[0-9]{2})\Z/ ) {
return
"$1"
;
}
elsif
(
$c
=~ /\A([0-9]{4})(?:[0-9]{2})(?:[0-9]{2})\/(?:[0-9]{2})\Z/ ) {
return
"$1"
;
}
elsif
(
$c
=~ /\A([0-9]{4})(?:[0-9]{2})(?:[0-9]{2})\/(?:[0-9]{2})(?:[0-9]{2})\Z/ ) {
return
"$1"
;
}
elsif
(
$c
=~ /\A([0-9]{4})(?:[0-9]{2})(?:[0-9]{2})\/([0-9]{4})(?:[0-9]{2})(?:[0-9]{2})\Z/ ) {
return
(
"$1"
,
"$2"
);
}
return
;
}
sub
month {
my
$self
=
shift
;
return
unless
$self
->has_chronology();
my
$c
=
$self
->chronology;
if
(
$c
=~ /\A(?:[0-9]{4})([0-9]{2})\Z/ ) {
return
"$1"
;
}
elsif
(
$c
=~ /\A(?:[0-9]{4})([0-9]{2})\/([0-9]{2})\Z/ ) {
return
(
"$1"
,
"$2"
);
}
elsif
(
$c
=~ /\A(?:[0-9]{4})([0-9]{2})\/(?:[0-9]{4})([0-9]{2})\Z/ ) {
return
(
"$1"
,
"$2"
);
}
elsif
(
$c
=~ /\A(?:[0-9]{4})([0-9]{2})(?:[0-9]{2})\Z/ ) {
return
"$1"
;
}
elsif
(
$c
=~ /\A(?:[0-9]{4})([0-9]{2})(?:[0-9]{2})\/(?:[0-9]{2})\Z/ ) {
return
"$1"
;
}
elsif
(
$c
=~ /\A(?:[0-9]{4})([0-9]{2})(?:[0-9]{2})\/([0-9]{2})(?:[0-9]{2})\Z/ ) {
return
(
"$1"
,
"$2"
);
}
elsif
(
$c
=~ /\A(?:[0-9]{4})([0-9]{2})(?:[0-9]{2})\/(?:[0-9]{4})([0-9]{2})(?:[0-9]{2})\Z/ ) {
return
(
"$1"
,
"$2"
);
}
return
;
}
sub
day {
my
$self
=
shift
;
return
unless
$self
->has_chronology();
my
$c
=
$self
->chronology;
if
(
$c
=~ /\A(?:[0-9]{4})(?:[0-9]{2})([0-9]{2})\Z/ ) {
return
"$1"
;
}
elsif
(
$c
=~ /\A(?:[0-9]{4})(?:[0-9]{2})([0-9]{2})\/([0-9]{2})\Z/ ) {
return
(
"$1"
,
"$2"
);
}
elsif
(
$c
=~ /\A(?:[0-9]{4})(?:[0-9]{2})([0-9]{2})\/(?:[0-9]{2})([0-9]{2})\Z/ ) {
return
(
"$1"
,
"$2"
);
}
elsif
(
$c
=~ /\A(?:[0-9]{4})(?:[0-9]{2})([0-9]{2})\/(?:[0-9]{4})(?:[0-9]{2})([0-9]{2})\Z/ ) {
return
(
"$1"
,
"$2"
);
}
return
;
}
sub
to_string {
my
$self
=
shift
;
my
$str
=
''
;
if
(
$self
->has_issn() ) {
$str
=
$self
->issn();
}
if
(
$self
->has_chronology() ) {
$str
.=
'('
.
$self
->chronology() .
')'
;
}
else
{
$str
.=
'()'
;
}
if
(
$self
->has_enumeration() ) {
$str
.=
$self
->enumeration();
}
else
{
if
(
$self
->has_volume() ) {
$str
.=
$self
->volume();
if
(
$self
->has_issue() ) {
$str
.=
':'
.
$self
->issue();
}
}
if
(
$self
->has_supplOrIdx() ) {
$str
.=
$self
->supplOrIdx();
}
}
return
$str
;
}
sub
reset
{
my
$self
=
shift
;
$self
->clear_issn();
$self
->clear_problem_on(
'issn'
);
$self
->clear_chronology();
$self
->clear_problem_on(
'chronology'
);
$self
->clear_enumeration();
$self
->clear_problem_on(
'enumeration'
);
$self
->clear_volume();
$self
->clear_problem_on(
'volumne'
);
$self
->clear_issue();
$self
->clear_problem_on(
'issue'
);
$self
->clear_supplOrIdx();
$self
->clear_problem_on(
'supplOrIdx'
);
return
;
}
1;