view release on metacpan or  search on metacpan

bin/zipdetails  view on Meta::CPAN

    return "Portability Issue: Windows filename cannot contain '$1'"
        if  $filename =~ /($illegal_windows_chars)/o ;

    return "Portability Issue: Null character '\\x00' is not allowed in a Windows or Linux filename"
        if  $filename =~ /\x00/ ;

    return sprintf "Portability Issue: Control character '\\x%02X' is not allowed in a Windows filename", ord($1)
        if  $filename =~ /([\x00-\x1F])/ ;

    return undef;
}

sub getOutputFilename
{
    my $raw_filename = shift;
    my $LanguageEncodingFlag = shift;
    my $message = shift // "Filename";

    my $filename ;
    my $decoded_filename;

    if ($raw_filename eq '')
    {
        if ($message eq 'Filename')
        {
            warning $FH->tell() ,
                "Filename ''",
                "Zero Length Filename" ;
        }

        return '', '', 0;
    }
    elsif ($opt_Redact)
    {
        return redactFilename($raw_filename), '', 0 ;
    }
    else
    {
        $decoded_filename = TextEncoding::decode($raw_filename, $message, $LanguageEncodingFlag) ;
        $filename = TextEncoding::encode($decoded_filename, $message, $LanguageEncodingFlag) ;
    }

    return $filename, $decoded_filename, $filename ne $raw_filename ;
}

sub outputFilename
{
    my $raw_filename = shift;
    my $LanguageEncodingFlag = shift;
    my $message = shift // "Filename";

    my ($filename, $decoded_filename, $modified) = getOutputFilename($raw_filename, $LanguageEncodingFlag);

    out $raw_filename, $message,  "'". $filename . "'";

    if (! $opt_Redact && TextEncoding::debugEncoding())
    {
        # use Devel::Peek;
        # print "READ     " ; Dump($raw_filename);
        # print "INTERNAL " ; Dump($decoded_filename);
        # print "OUTPUT   " ; Dump($filename);

        debug $FH->tell() - length($raw_filename),
                    "$message Encoding Change"
            if $modified ;

        # use Unicode::Normalize;
        # my $NormalizedForm ;
        # if (defined $decoded_filename)
        # {
        #     $NormalizedForm .= Unicode::Normalize::checkNFD  $decoded_filename ? 'NFD ' : '';
        #     $NormalizedForm .= Unicode::Normalize::checkNFC  $decoded_filename ? 'NFC ' : '';
        #     $NormalizedForm .= Unicode::Normalize::checkNFKD $decoded_filename ? 'NFKD ' : '';
        #     $NormalizedForm .= Unicode::Normalize::checkNFKC $decoded_filename ? 'NFKC ' : '';
        #     $NormalizedForm .= Unicode::Normalize::checkFCD  $decoded_filename ? 'FCD ' : '';
        #     $NormalizedForm .= Unicode::Normalize::checkFCC  $decoded_filename ? 'FCC ' : '';
        # }

        debug $FH->tell() - length($raw_filename),
                    "Encoding Debug for $message",
                    "Octets Read from File  [$raw_filename][" . length($raw_filename). "] [" . charDump2($raw_filename) . "]",
                    "Via Unicode Codepoints [$decoded_filename][" . length($decoded_filename) . "] [" . charDump($decoded_filename) . "]",
                    # "Unicode Normalization  $NormalizedForm",
                    "Octets Written         [$filename][" . length($filename). "] [" . charDump2($filename) . "]";
    }

    if ($message eq 'Filename' && $opt_want_warning_messages)
    {
        # Check for bad, unsafe & not portable filenames
        my $v = validateFilename($decoded_filename);

        if ($v)
        {
            my @v = ref $v eq 'ARRAY'
                        ? @$v
                        : $v;

            warning $FH->tell() - length($raw_filename),
                "Filename '$filename'",
                @v
        }
    }

    return $filename;
}

sub CentralHeader
{
    my $signature = shift ;
    my $data = shift ;
    my $startRecordOffset = shift ;

    my $cdEntryOffset = $FH->tell() - 4 ;

    ++ $CentralHeaderCount;

    print "\n";
    out $data, "CENTRAL HEADER #$CentralHeaderCount", Value_V($signature);
    my $buffer;

    need 42, Signatures::name($signature);