mirror of
				https://codeberg.org/h3xx/simplify_static_dir
				synced 2024-08-14 23:57:24 +00:00 
			
		
		
		
	Unpack @_ first (PBP)
This commit is contained in:
		
							parent
							
								
									907a7113a8
								
							
						
					
					
						commit
						7dbbb5422a
					
				
					 8 changed files with 28 additions and 22 deletions
				
			
		|  | @ -6,8 +6,7 @@ require Cwd; | |||
| use File::Basename qw/ dirname /; | ||||
| 
 | ||||
| sub new { | ||||
|     my $class = shift; | ||||
|     my $rel_name = shift; | ||||
|     my ($class, $rel_name) = @_; | ||||
|     my $self = bless { | ||||
|         rel_name => $rel_name, | ||||
|         name => Cwd::abs_path($rel_name), | ||||
|  |  | |||
|  | @ -13,11 +13,11 @@ require Directory::Simplify::File; | |||
| # :squash-remove-end: | ||||
| 
 | ||||
| sub new { | ||||
|     my $class = shift; | ||||
|     my ($class, %args) = @_; | ||||
|     return bless { | ||||
|         _entries => {}, | ||||
|         _files_in_hash => {}, | ||||
|         @_, | ||||
|         %args, | ||||
|     }, $class; | ||||
| } | ||||
| 
 | ||||
|  |  | |||
|  | @ -9,9 +9,9 @@ require Directory::Simplify::Utils; | |||
| # :squash-remove-end: | ||||
| 
 | ||||
| sub new { | ||||
|     my $class = shift; | ||||
|     my ($class, %args) = @_; | ||||
|     return bless { | ||||
|         @_, | ||||
|         %args, | ||||
|     }, $class; | ||||
| } | ||||
| 
 | ||||
|  |  | |||
|  | @ -11,11 +11,11 @@ require Directory::Simplify::Instruction::Hardlink; | |||
| # :squash-remove-end: | ||||
| 
 | ||||
| sub new { | ||||
|     my $class = shift; | ||||
|     my ($class, %args) = @_; | ||||
|     return bless { | ||||
|         filehash => undef, | ||||
|         min_size => 1, | ||||
|         @_, | ||||
|         %args, | ||||
|     }, $class; | ||||
| } | ||||
| 
 | ||||
|  |  | |||
|  | @ -9,10 +9,10 @@ require Directory::Simplify::Utils; | |||
| # :squash-remove-end: | ||||
| 
 | ||||
| sub new { | ||||
|     my $class = shift; | ||||
|     my ($class, %args) = @_; | ||||
|     return bless { | ||||
|         freed => 0, | ||||
|         @_, | ||||
|         %args, | ||||
|     }, $class; | ||||
| } | ||||
| 
 | ||||
|  |  | |||
|  | @ -4,8 +4,9 @@ use strict; | |||
| use warnings; | ||||
| 
 | ||||
| sub addcommas { | ||||
|     my @numbers = @_; | ||||
|     my @added; | ||||
|     foreach my $num (@_) { | ||||
|     foreach my $num (@numbers) { | ||||
|         # don't split anything after the decimal | ||||
|         my @parts = split /\./, $num; | ||||
|         while ($parts[0] =~ s/(\d)(\d{3}(?:\D|$))/$1,$2/) { | ||||
|  | @ -36,11 +37,12 @@ sub hr_size { | |||
| 
 | ||||
| sub shell_quote { | ||||
|     # shell-escape argument for inclusion in non-interpolated single quotes | ||||
|     my @words = @_; | ||||
|     my @transformed = map { | ||||
|         (my $out = $_) | ||||
|             =~ s/'/'\\''/g; | ||||
|         "'$out'"; | ||||
|     } @_; | ||||
|     } @words; | ||||
|     wantarray ? @transformed : $transformed[0]; | ||||
| } | ||||
| 
 | ||||
|  |  | |||
|  | @ -30,7 +30,7 @@ our @EXPORT = qw/ | |||
| use constant SCRIPT => $ENV{SCRIPT} // abs_path dirname(__FILE__) . '/../simplify_static_dir-main.pl'; | ||||
| 
 | ||||
| sub are_hardlinked { | ||||
|     my $starter = shift; | ||||
|     my ($starter, @files) = @_; | ||||
| 
 | ||||
|     my $gen_ident = sub { | ||||
|         my ($dev, $ino) = stat $_[0]; | ||||
|  | @ -38,7 +38,7 @@ sub are_hardlinked { | |||
|     }; | ||||
| 
 | ||||
|     my $starter_ident = $gen_ident->($starter); | ||||
|     foreach my $file (@_) { | ||||
|     foreach my $file (@files) { | ||||
|         if ($gen_ident->($file) ne $starter_ident) { | ||||
|             return 0; | ||||
|         } | ||||
|  | @ -47,7 +47,8 @@ sub are_hardlinked { | |||
| } | ||||
| 
 | ||||
| sub file_exists { | ||||
|     foreach my $file (@_) { | ||||
|     my @files = @_; | ||||
|     foreach my $file (@files) { | ||||
|         unless (-e $file) { | ||||
|             return 0; | ||||
|         } | ||||
|  | @ -56,12 +57,13 @@ sub file_exists { | |||
| } | ||||
| 
 | ||||
| sub filemtime { | ||||
|     (stat shift)[9]; | ||||
|     my $file = shift; | ||||
|     return (stat $file)[9]; | ||||
| } | ||||
| 
 | ||||
| sub has_mtime { | ||||
|     my $mtime = shift; | ||||
|     foreach my $file (@_) { | ||||
|     my ($mtime, @files) = @_; | ||||
|     foreach my $file (@files) { | ||||
|         if (filemtime($file) != $mtime) { | ||||
|             return 0; | ||||
|         } | ||||
|  | @ -96,7 +98,8 @@ sub prep_tar { | |||
| } | ||||
| 
 | ||||
| sub run_script_capture { | ||||
|     my @cmd =(SCRIPT, @_); | ||||
|     my @args = @_; | ||||
|     my @cmd = (SCRIPT, @args); | ||||
| 
 | ||||
|     use IPC::Open3 qw/ open3 /; | ||||
|     my $stderr = File::Temp->new( | ||||
|  | @ -123,8 +126,9 @@ sub run_script_capture { | |||
| } | ||||
| 
 | ||||
| sub run_script { | ||||
|     print STDERR '+ ' . SCRIPT . " @_\n"; | ||||
|     system SCRIPT, @_; | ||||
|     my @args = @_; | ||||
|     print STDERR '+ ' . SCRIPT . " @args\n"; | ||||
|     return system SCRIPT, @args; | ||||
| } | ||||
| 
 | ||||
| 1; | ||||
|  |  | |||
|  | @ -17,8 +17,9 @@ my (undef, $stdout, $stderr) = run_script_capture('-f', $test_dir); | |||
| ok "freed 1,048,576 bytes (1 MB)\n" eq $stderr, 'prints freed bytes with commas'; | ||||
| 
 | ||||
| sub put_file { | ||||
|     my @files = @_; | ||||
|     my $bytes = 1048576; # 1 MB | ||||
|     foreach my $file (@_) { | ||||
|     foreach my $file (@files) { | ||||
|         open my $fh, '>', $file | ||||
|             or die "Failed to open file $file for writing: $!"; | ||||
|         for (my $bytes_written = 0; $bytes_written < $bytes; ++$bytes_written) { | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue