sub
new {
my
(
$class
,
$filename
) =
@_
;
die
"Missing filename"
unless
defined
$filename
;
my
$fragment_definition
=
qr/(?: [0-9] | [1-9][0-9]+ | pre | post )/
x;
my
$fragment
=
qr/\: $fragment_definition
(?: , $fragment_definition )*
/
x;
my
$ext
=
qr{\.muse}
;
my
@fragments
;
if
(
$filename
=~ m/(
$ext
)?(
$fragment
)\z/) {
my
$fragment_path
= $2;
$filename
=~ s/
$fragment
\z//;
$fragment_path
=~ s/\A\://;
@fragments
=
split
(/,/,
$fragment_path
);
}
my
(
$name
,
$path
,
$suffix
) = File::Basename::fileparse(
$filename
,
$ext
);
my
$self
= {
name
=>
$name
,
path
=>
$path
,
suffix
=>
'.muse'
,
fragments
=> (
scalar
(
@fragments
) ? \
@fragments
:
undef
),
};
bless
$self
,
$class
;
}
sub
name {
shift
->{name} };
sub
path {
shift
->{path} };
sub
suffix {
shift
->{suffix} };
sub
fragments {
return
@{
shift
->{fragments} || [] } }
sub
fragments_specification {
my
$self
=
shift
;
my
$out
=
''
;
if
(
my
@fragments
=
$self
->fragments) {
$out
=
':'
.
join
(
','
,
@fragments
);
}
return
$out
;
}
sub
name_with_fragments {
my
$self
=
shift
;
return
$self
->name .
$self
->fragments_specification;
}
sub
name_with_ext_and_fragments {
my
$self
=
shift
;
return
$self
->name .
$self
->suffix .
$self
->fragments_specification;
}
sub
filename {
my
$self
=
shift
;
return
$self
->name .
$self
->suffix;
}
sub
full_path {
my
$self
=
shift
;
return
$self
->path .
$self
->filename;
}
sub
text_amuse_constructor {
my
$self
=
shift
;
my
%constructor
= (
file
=>
$self
->filename);
if
(
my
@fragments
=
$self
->fragments) {
$constructor
{partial} = \
@fragments
;
}
return
%constructor
;
}
1;