79 lines
1.1 KiB
Perl
79 lines
1.1 KiB
Perl
#!/usr/bin/perl
|
|
# SPDX-License-Identifier: MIT
|
|
|
|
use strict;
|
|
|
|
sub getcf ()
|
|
{
|
|
local *FH = shift @_;
|
|
my $size = shift @_;
|
|
my $buf;
|
|
read(FH, $buf, $size);
|
|
return $buf;
|
|
}
|
|
|
|
sub mkdir_p ()
|
|
{
|
|
my $fullpath = shift @_;
|
|
my @list;
|
|
|
|
if (-d $fullpath) {
|
|
return;
|
|
}
|
|
|
|
$fullpath =~ s/\/+$//go;
|
|
$fullpath =~ s/^~(?!\w)/$ENV{HOME}/so;
|
|
$fullpath =~ s/\/$//so;
|
|
@list = split(/\//so, $fullpath);
|
|
|
|
for (my $i = 0; $i < scalar(@list); ++$i) {
|
|
my $dir = join("/", @list[0..$i]);
|
|
if ($dir eq "") {
|
|
next;
|
|
}
|
|
if (!-e $dir && !mkdir($dir)) {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub mkdir_p_stripbase ()
|
|
{
|
|
my $s = shift @_;
|
|
|
|
$s =~ s{^(.*)/.*}{$1}is;
|
|
return &mkdir_p($s);
|
|
}
|
|
|
|
sub transfer ()
|
|
{
|
|
local *OUT = shift @_;
|
|
local *IN = shift @_;
|
|
my $size = shift @_;
|
|
my $offset = shift @_;
|
|
my $saved_offset;
|
|
my $buf;
|
|
|
|
if (defined($offset)) {
|
|
$saved_offset = tell(IN);
|
|
seek(IN, $offset, 0);
|
|
}
|
|
|
|
while ($size > 0) {
|
|
my $rem = ($size > 4096) ? 4096 : $size;
|
|
read(IN, $buf, $rem);
|
|
print OUT $buf;
|
|
$size -= $rem;
|
|
}
|
|
|
|
if (defined($offset)) {
|
|
seek(IN, $saved_offset, 0);
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
1;
|