use
version;
our
$VERSION
= version->declare(
"v0.2.1"
);
sub
parse_directory {
my
(
$directory
) =
@_
;
my
$inuse
=
unpack
(
'C'
,
$directory
);
my
$datasize
=
unpack
(
'V'
,
substr
(
$directory
, 0x4, 0x4));
my
$linkindex
=
unpack
(
'v'
,
substr
(
$directory
, 0x8));
my
$codestr
=
unpack
(
'Z*'
,
substr
(
$directory
, 0xA));
my
@toxor
=
unpack
(
'C127'
,
$directory
);
my
$storedxor
=
unpack
(
'C'
,
substr
(
$directory
, 0x7F));
my
$blockcount
=
int
(
$datasize
/ 0x2000);
my
$calcxor
= 0;
foreach
my
$char
(
@toxor
) {
$calcxor
^=
$char
;
}
return
{
'inuse'
=>
$inuse
,
'datasize'
=>
$datasize
,
'linkindex'
=>
$linkindex
,
'codename'
=>
$codestr
,
'xor'
=>
$storedxor
,
'calcxor'
=>
$calcxor
,
'calcblocks'
=>
$blockcount
};
}
sub
parse_file_header {
my
(
$file
) =
@_
;
my
$id
=
unpack
(
'a2'
,
$file
);
my
$displayflag
=
unpack
(
'C'
,
substr
(
$file
, 0x2));
my
$blocknum
=
unpack
(
'C'
,
substr
(
$file
, 0x3));
my
$shiftjisbuf
=
unpack
(
'a64'
,
substr
(
$file
, 0x4, 0x40));
my
@clut
=
unpack
(
'v16'
,
substr
(
$file
, 0x60, 0x20));
my
$iconfnt
= 0;
if
((
$displayflag
>= 0x11)|| (
$displayflag
<= 0x13)) {
$iconfnt
=
$displayflag
- 0x10;
}
my
$firstnul
=
index
(
$shiftjisbuf
,
"\0"
);
if
(
$firstnul
!= -1) {
$shiftjisbuf
=
substr
(
$shiftjisbuf
, 0,
$firstnul
);
}
my
$shiftjis
= decode(
'shiftjis'
,
$shiftjisbuf
);
return
{
'id'
=>
$id
,
'displayflag'
=>
$displayflag
,
'blocknum'
=>
$blocknum
,
'titlebuf'
=>
$shiftjisbuf
,
'clut'
=> \
@clut
,
'title'
=>
$shiftjis
,
'framecnt'
=>
$iconfnt
};
}
sub
is_mcd {
my
(
$res
) =
@_
;
(
substr
(
$res
, 0, 2) eq
'MC'
) or
return
0;
return
(
length
(
$res
) == 131072);
}
sub
is_mcs {
my
(
$res
) =
@_
;
my
$datasize
=
length
(
$res
) - 0x80;
return
((
$datasize
% 0x2000) == 0);
}
sub
xordirectory {
my
(
$directory
) =
@_
;
my
@toxor
=
unpack
(
'C127'
,
$directory
);
my
$xor
= 0;
foreach
my
$char
(
@toxor
) {
$xor
^=
$char
;
}
return
$xor
;
}
sub
load {
my
(
$class
,
$filename
,
$overridefilename
) =
@_
;
my
$fh
;
if
(
$filename
ne
'-'
) {
open
(
$fh
,
'<'
,
$filename
) or
die
(
"failed to open: $filename"
);
}
else
{
$fh
=
*STDIN
;
$filename
=
'STDIN'
;
}
my
%self
= (
'filename'
=>
$filename
,
'contents'
=>
''
);
my
$res
=
read
(
$fh
,
$self
{
'contents'
}, 131073);
((
$res
) && (
$res
<= 131072)) or
return
undef
;
if
(is_mcd(
$self
{
'contents'
})) {
$self
{
'type'
} =
'mcd'
;
}
elsif
(is_mcs(
$self
{
'contents'
})) {
$self
{
'type'
} =
'mcs'
;
}
elsif
((
$res
<= (15*0x2000)) && (
$res
>= 0x2000) && ((
$res
% 0x2000) == 0)) {
$self
{
'type'
} =
'rawsave'
;
my
$filecodename
= (
$filename
ne
'STDIN'
) ? basename(
$filename
) :
undef
;
$self
{
'codename'
} =
$overridefilename
?
$overridefilename
:
$filecodename
;
}
elsif
(
substr
(
$res
, 0, 2) eq
'MC'
) {
warn
(
"File starts with MC, but filesize is $res. Assuming type is mcd"
);
$self
{
'type'
} =
'mcd'
;
}
else
{
return
undef
;
}
if
((
$self
{
'type'
} eq
'mcd'
) || (
$self
{
'type'
} eq
'mcs'
)) {
$self
{
'hasdir'
} = 1;
}
bless
\
%self
,
$class
;
return
\
%self
;
}
sub
foreachDirEntry {
my
(
$self
,
$callback
) =
@_
;
(
$self
->{
'type'
} eq
'mcd'
) or
die
(
"Unhandled filetype"
);
my
$startindex
= 1;
my
$dataoffset
= 0x2000;
my
$maxcount
= 15;
for
(
my
$i
=
$startindex
;
$i
< (
$startindex
+
$maxcount
);
$i
++) {
my
$entrydata
=
substr
(
$self
->{
'contents'
}, (
$i
* 0x80), 0x80);
my
$entry
= parse_directory(
$entrydata
);
my
$save
;
if
(
$entry
->{
'inuse'
} == 0x51) {
$save
= {
'filename'
=>
$entry
->{
'codename'
},
'data'
=>
substr
(
$self
->{
'contents'
},
$dataoffset
,
$entry
->{
'datasize'
}),
};
}
$callback
->(
$entry
,
$save
,
$entrydata
);
$dataoffset
+= 0x2000;
}
}
sub
_readMCSSave {
my
(
$self
) =
@_
;
my
$entrydata
=
substr
(
$self
->{
'contents'
}, 0, 0x80);
my
$entry
= parse_directory(
$entrydata
);
return
{
'filename'
=>
$entry
->{
'codename'
},
'data'
=>
substr
(
$self
->{
'contents'
}, 0x80,
$entry
->{
'datasize'
})
};
}
sub
_readRawSave {
my
(
$self
) =
@_
;
$self
->{
'codename'
} or
die
(
"cannot read raw save without a filename"
);
return
{
'filename'
=>
$self
->{
'codename'
},
'data'
=>
$self
->{
'contents'
}
};
}
sub
readSave {
my
(
$self
) =
@_
;
if
(
$self
->{
'type'
} eq
'mcs'
) {
return
_readMCSSave(
$self
);
}
elsif
(
$self
->{
'type'
} eq
'rawsave'
) {
return
_readRawSave(
$self
);
}
else
{
die
(
"unimplemented type"
);
}
}
sub
FormatSaveFirstDirEntry {
my
(
$save
,
$dirindex
) =
@_
;
my
$savelen
=
length
(
$save
->{
'data'
});
my
$blockcount
=
length
(
$save
->{
'data'
}) / 0x2000;
((
$blockcount
% 1) == 0) or
die
(
"not integer blocksize"
);
(
$blockcount
>= 1) or
die
(
"must have at least one block"
);
my
$blockptr
= (
$blockcount
== 1) ? 0xFFFF :
$dirindex
;
my
$directory
=
pack
(
'VVvZ21x96'
, 0x51,
$savelen
,
$blockptr
,
$save
->{
'filename'
});
$directory
.=
pack
(
'C'
, xordirectory(
$directory
));
return
(
$directory
,
$blockcount
);
}
sub
FormatSaveAsMCD {
my
(
$dirstart
,
$save
) =
@_
;
my
$dirindex
= (
$dirstart
/ 0x80);
my
(
$directory
,
$blockcount
) = FormatSaveFirstDirEntry(
$save
,
$dirindex
);
if
(
$blockcount
> 1) {
while
(
$blockcount
> 2) {
$dirindex
++;
my
$newdir
=
pack
(
'VVvx117'
, 0x52, 0x0,
$dirindex
);
$newdir
.=
pack
(
'C'
, xordirectory(
$newdir
));
$directory
.=
$newdir
;
$blockcount
--;
}
my
$newdir
=
pack
(
'VVvx117'
, 0x53, 0x0, 0xFFFF);
$newdir
.=
pack
(
'C'
, xordirectory(
$newdir
));
$directory
.=
$newdir
;
}
return
{
'dirdata'
=>
$directory
,
'savedata'
=>
$save
->{
'data'
}
};
}
sub
FormatSaveAsMCS {
my
(
$save
) =
@_
;
my
(
$directory
,
$blockcount
) = FormatSaveFirstDirEntry(
$save
, 1);
return
$directory
.=
$save
->{
'data'
};
}
sub
SaveNameAndTitleMatch {
my
(
$save
,
$string
) =
@_
;
$save
->{
'header'
} //= PlayStation::MemoryCard::parse_file_header(
$save
->{
'data'
});
my
$title
=
$save
->{
'header'
}{
'title'
};
my
$asciititle
=
$title
;
$asciititle
=~
tr
/\x{3000}\x{FF01}-\x{FF5E}/ -~/;
return
(!
$string
||
(
$save
->{
'filename'
} eq
$string
) || (
$title
eq
$string
) || (
$asciititle
eq
$string
) ||
(
$save
->{
'filename'
} =~ /\Q
$string
\E/i) || (
$title
=~ /\Q
$string
\E/i) || (
$asciititle
=~ /\Q
$string
\E/i));
}
sub
BlankMCD {
my
$cardbuf
=
pack
(
'x131072'
);
substr
(
$cardbuf
, 0, 2,
'MC'
);
substr
(
$cardbuf
, 0x7F, 1,
pack
(
'C'
, 0x0E));
for
(
my
$i
= 1;
$i
< 16;
$i
++) {
my
$frameoffset
=
$i
*0x80;
substr
(
$cardbuf
,
$frameoffset
, 1,
pack
(
'C'
, 0xA0));
substr
(
$cardbuf
,
$frameoffset
+0x8, 2,
pack
(
'v'
, 0xFFFF));
substr
(
$cardbuf
,
$frameoffset
+0x7F, 1,
pack
(
'C'
, 0xA0));
}
for
(
my
$i
= 16;
$i
< 36;
$i
++) {
my
$frameoffset
=
$i
*0x80;
substr
(
$cardbuf
,
$frameoffset
, 4,
pack
(
'V'
, 0xFFFFFFFF));
substr
(
$cardbuf
,
$frameoffset
+0x8, 2,
pack
(
'v'
, 0xFFFF));
}
return
$cardbuf
;
}
1;