added on local at 2026-07-01 22:09:40
| 1 | package MODS::ShopCart::Storage; | |
| 2 | #====================================================================== | |
| 3 | # ShopCart -- per-file + total-storage cap enforcement. | |
| 4 | # | |
| 5 | # All upload paths call check_upload_allowed() BEFORE writing the file | |
| 6 | # to disk + DB. After a successful write, the caller calls bump_usage() | |
| 7 | # with the delta. A cron worker (_storage_alert_worker.pl) periodically | |
| 8 | # fires soft-alert emails for users above the threshold and recomputes | |
| 9 | # stale storage_used_bytes totals from authoritative source tables. | |
| 10 | # | |
| 11 | # Tier defaults (per-file MB, total cap GB, alert pct) come from | |
| 12 | # platform_settings via MODS::ShopCart::Config. Per-user overrides on | |
| 13 | # the users row (upload_max_mb_override, storage_hard_cap_gb_override) | |
| 14 | # win when present. | |
| 15 | # | |
| 16 | # The module is deliberately stateless on $self -- every public call | |
| 17 | # takes ($db, $dbh, $DB, $uid) so it can be used from CGIs, workers, | |
| 18 | # and the smoke test without per-process caching surprises. | |
| 19 | #====================================================================== | |
| 20 | use strict; | |
| 21 | use warnings; | |
| 22 | ||
| 23 | use MODS::ShopCart::Config; | |
| 24 | ||
| 25 | # Soft alert debounce window. We will not re-send the alert until at | |
| 26 | # least this many hours have elapsed since users.last_storage_alert_at. | |
| 27 | use constant SOFT_ALERT_DEBOUNCE_HOURS => 24; | |
| 28 | ||
| 29 | sub new { | |
| 30 | my ($class) = @_; | |
| 31 | my $config = MODS::ShopCart::Config->new; | |
| 32 | return bless({ config => $config }, $class); | |
| 33 | } | |
| 34 | ||
| 35 | #---------------------------------------------------------------------- | |
| 36 | # limits_for_user($db, $dbh, $DB, $uid) | |
| 37 | # | |
| 38 | # Returns a hashref: | |
| 39 | # { | |
| 40 | # tier => 'free' | 'pro' | 'business', | |
| 41 | # upload_max_bytes => 26214400, # per-file cap, after override | |
| 42 | # hard_cap_bytes => 5368709120, # total cap, after override | |
| 43 | # soft_alert_bytes => 4294967296, # threshold for soft alert (80% of hard) | |
| 44 | # used_bytes => 0, # current denormalized total | |
| 45 | # } | |
| 46 | # | |
| 47 | # Falls back gracefully if the override columns / settings are absent. | |
| 48 | #---------------------------------------------------------------------- | |
| 49 | sub limits_for_user { | |
| 50 | my ($self, $db, $dbh, $DB, $uid) = @_; | |
| 51 | $uid =~ s/[^0-9]//g; | |
| 52 | return undef unless $uid; | |
| 53 | ||
| 54 | my $row = $db->db_readwrite($dbh, qq~ | |
| 55 | SELECT plan_tier, upload_max_mb_override, storage_hard_cap_gb_override, | |
| 56 | storage_used_bytes | |
| 57 | FROM `${DB}`.users | |
| 58 | WHERE id = '$uid' LIMIT 1 | |
| 59 | ~, $ENV{SCRIPT_NAME} || 'Storage.pm', __LINE__); | |
| 60 | return undef unless $row && $row->{plan_tier}; | |
| 61 | ||
| 62 | my $tier = lc($row->{plan_tier} || 'free'); | |
| 63 | $tier = 'free' unless $tier =~ /^(free|pro|business)$/; | |
| 64 | ||
| 65 | my $upload_mb_default = $self->{config}->settings("storage_upload_max_mb_$tier") || 25; | |
| 66 | my $hard_gb_default = $self->{config}->settings("storage_hard_cap_gb_$tier") || 5; | |
| 67 | my $alert_pct = $self->{config}->settings('storage_soft_alert_pct'); | |
| 68 | $alert_pct = 80 unless defined $alert_pct && $alert_pct =~ /^\d+$/; | |
| 69 | ||
| 70 | my $upload_mb = defined $row->{upload_max_mb_override} && length $row->{upload_max_mb_override} | |
| 71 | ? $row->{upload_max_mb_override} + 0 | |
| 72 | : $upload_mb_default + 0; | |
| 73 | my $hard_gb = defined $row->{storage_hard_cap_gb_override} && length $row->{storage_hard_cap_gb_override} | |
| 74 | ? $row->{storage_hard_cap_gb_override} + 0 | |
| 75 | : $hard_gb_default + 0; | |
| 76 | ||
| 77 | my $upload_bytes = $upload_mb * 1048576; | |
| 78 | my $hard_bytes = $hard_gb * 1073741824; | |
| 79 | my $soft_bytes = $alert_pct > 0 | |
| 80 | ? int($hard_bytes * $alert_pct / 100) | |
| 81 | : $hard_bytes; # 0 => effectively disabled | |
| 82 | ||
| 83 | return { | |
| 84 | tier => $tier, | |
| 85 | upload_max_bytes => $upload_bytes, | |
| 86 | hard_cap_bytes => $hard_bytes, | |
| 87 | soft_alert_bytes => $soft_bytes, | |
| 88 | used_bytes => ($row->{storage_used_bytes} || 0) + 0, | |
| 89 | alert_pct => $alert_pct, | |
| 90 | }; | |
| 91 | } | |
| 92 | ||
| 93 | #---------------------------------------------------------------------- | |
| 94 | # check_upload_allowed($db, $dbh, $DB, $uid, $file_size_bytes) | |
| 95 | # | |
| 96 | # Pre-upload gate. Returns (1, undef) on OK; (0, "user-readable msg") | |
| 97 | # on reject. Checks per-file AND total-storage. Reject messages are | |
| 98 | # safe to display verbatim to the user. | |
| 99 | #---------------------------------------------------------------------- | |
| 100 | sub check_upload_allowed { | |
| 101 | my ($self, $db, $dbh, $DB, $uid, $file_size_bytes) = @_; | |
| 102 | $file_size_bytes = 0 unless defined $file_size_bytes; | |
| 103 | $file_size_bytes += 0; | |
| 104 | ||
| 105 | my $L = $self->limits_for_user($db, $dbh, $DB, $uid); | |
| 106 | return (0, 'storage limits unavailable -- contact support') unless $L; | |
| 107 | ||
| 108 | my $tier_label = ucfirst($L->{tier}); | |
| 109 | ||
| 110 | # Per-file gate | |
| 111 | if ($file_size_bytes > $L->{upload_max_bytes}) { | |
| 112 | my $msg = sprintf( | |
| 113 | 'file is %s; the %s plan allows up to %s per file (contact your admin for an override)', | |
| 114 | _human_size($file_size_bytes), | |
| 115 | $tier_label, | |
| 116 | _human_size($L->{upload_max_bytes}), | |
| 117 | ); | |
| 118 | return (0, $msg); | |
| 119 | } | |
| 120 | ||
| 121 | # Total-storage gate (this upload would push past the hard cap) | |
| 122 | my $projected = $L->{used_bytes} + $file_size_bytes; | |
| 123 | if ($projected > $L->{hard_cap_bytes}) { | |
| 124 | my $msg = sprintf( | |
| 125 | "you've used %s of %s; this %s upload would exceed the cap -- delete some files or upgrade your plan", | |
| 126 | _human_size($L->{used_bytes}), | |
| 127 | _human_size($L->{hard_cap_bytes}), | |
| 128 | _human_size($file_size_bytes), | |
| 129 | ); | |
| 130 | return (0, $msg); | |
| 131 | } | |
| 132 | ||
| 133 | return (1, undef); | |
| 134 | } | |
| 135 | ||
| 136 | #---------------------------------------------------------------------- | |
| 137 | # bump_usage($db, $dbh, $DB, $uid, $delta_bytes) | |
| 138 | # | |
| 139 | # Adjusts users.storage_used_bytes by $delta_bytes. Positive on upload, | |
| 140 | # negative on delete. Uses GREATEST(0, ...) so the denormalized total | |
| 141 | # never goes below zero even on accounting drift. | |
| 142 | #---------------------------------------------------------------------- | |
| 143 | sub bump_usage { | |
| 144 | my ($self, $db, $dbh, $DB, $uid, $delta_bytes) = @_; | |
| 145 | $uid =~ s/[^0-9]//g; | |
| 146 | return unless $uid; | |
| 147 | $delta_bytes = 0 unless defined $delta_bytes; | |
| 148 | $delta_bytes = int($delta_bytes); | |
| 149 | return unless $delta_bytes; | |
| 150 | ||
| 151 | # MariaDB CAST to SIGNED so we can add a negative without underflow | |
| 152 | # before the GREATEST clamp catches it. | |
| 153 | my $delta_q = $dbh->quote($delta_bytes); | |
| 154 | $db->db_readwrite($dbh, qq~ | |
| 155 | UPDATE `${DB}`.users | |
| 156 | SET storage_used_bytes = GREATEST(0, CAST(storage_used_bytes AS SIGNED) + $delta_q) | |
| 157 | WHERE id = '$uid' LIMIT 1 | |
| 158 | ~, $ENV{SCRIPT_NAME} || 'Storage.pm', __LINE__); | |
| 159 | } | |
| 160 | ||
| 161 | #---------------------------------------------------------------------- | |
| 162 | # recompute_usage($db, $dbh, $DB, $uid) | |
| 163 | # | |
| 164 | # Authoritative recompute. Sums: | |
| 165 | # - model_files.file_size_bytes for models owned by $uid (joined) | |
| 166 | # - model_images via filesystem stat() on storage_key (no size col) | |
| 167 | # - page_images.size_bytes for $uid | |
| 168 | # - support_attachments.size_bytes for $uid | |
| 169 | # | |
| 170 | # Writes the result to users.storage_used_bytes and stamps | |
| 171 | # storage_used_at_recompute = NOW(). Returns the new used_bytes value. | |
| 172 | #---------------------------------------------------------------------- | |
| 173 | sub recompute_usage { | |
| 174 | my ($self, $db, $dbh, $DB, $uid) = @_; | |
| 175 | $uid =~ s/[^0-9]//g; | |
| 176 | return 0 unless $uid; | |
| 177 | ||
| 178 | my $total = 0; | |
| 179 | ||
| 180 | # ---- model_files (joined via models.user_id) ---- | |
| 181 | my $mf = $db->db_readwrite($dbh, qq~ | |
| 182 | SELECT COALESCE(SUM(mf.file_size_bytes), 0) AS s | |
| 183 | FROM `${DB}`.model_files mf | |
| 184 | JOIN `${DB}`.models m ON m.id = mf.model_id | |
| 185 | WHERE m.user_id = '$uid' | |
| 186 | ~, $ENV{SCRIPT_NAME} || 'Storage.pm', __LINE__); | |
| 187 | $total += ($mf && $mf->{s}) ? $mf->{s} : 0; | |
| 188 | ||
| 189 | # ---- page_images.size_bytes (direct user_id) ---- | |
| 190 | my $pi = eval { | |
| 191 | $db->db_readwrite($dbh, qq~ | |
| 192 | SELECT COALESCE(SUM(size_bytes), 0) AS s | |
| 193 | FROM `${DB}`.page_images | |
| 194 | WHERE user_id = '$uid' | |
| 195 | ~, $ENV{SCRIPT_NAME} || 'Storage.pm', __LINE__); | |
| 196 | }; | |
| 197 | $total += ($pi && $pi->{s}) ? $pi->{s} : 0; | |
| 198 | ||
| 199 | # ---- support_attachments.size_bytes (direct user_id) ---- | |
| 200 | my $sa = eval { | |
| 201 | $db->db_readwrite($dbh, qq~ | |
| 202 | SELECT COALESCE(SUM(size_bytes), 0) AS s | |
| 203 | FROM `${DB}`.support_attachments | |
| 204 | WHERE user_id = '$uid' | |
| 205 | ~, $ENV{SCRIPT_NAME} || 'Storage.pm', __LINE__); | |
| 206 | }; | |
| 207 | $total += ($sa && $sa->{s}) ? $sa->{s} : 0; | |
| 208 | ||
| 209 | # ---- model_images: no size column. stat() each storage_key path. | |
| 210 | # Capped at $MAX_IMG_STATS rows so a runaway gallery doesn't make | |
| 211 | # recompute O(slow). For the foundation layer that's good enough -- | |
| 212 | # we can add a width_px*height_px*3 estimator later if needed. | |
| 213 | my $base_dir = '/var/www/vhosts/3dshawn.com/shop.3dshawn.com'; | |
| 214 | my @img_rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 215 | SELECT mi.storage_key | |
| 216 | FROM `${DB}`.model_images mi | |
| 217 | JOIN `${DB}`.models m ON m.id = mi.model_id | |
| 218 | WHERE m.user_id = '$uid' | |
| 219 | LIMIT 5000 | |
| 220 | ~, $ENV{SCRIPT_NAME} || 'Storage.pm', __LINE__); | |
| 221 | foreach my $r (@img_rows) { | |
| 222 | my $key = ref($r) eq 'HASH' ? $r->{storage_key} : undef; | |
| 223 | next unless defined $key && length $key; | |
| 224 | next if $key =~ /\.\./; # path traversal guard | |
| 225 | next unless $key =~ m{^(uploads/|[a-zA-Z0-9])}; | |
| 226 | my $path = "$base_dir/$key"; | |
| 227 | my $sz = -s $path; | |
| 228 | $total += $sz if $sz && $sz > 0; | |
| 229 | } | |
| 230 | ||
| 231 | # ---- Write back ---- | |
| 232 | my $total_q = $dbh->quote($total); | |
| 233 | $db->db_readwrite($dbh, qq~ | |
| 234 | UPDATE `${DB}`.users | |
| 235 | SET storage_used_bytes = $total_q, | |
| 236 | storage_used_at_recompute = NOW() | |
| 237 | WHERE id = '$uid' LIMIT 1 | |
| 238 | ~, $ENV{SCRIPT_NAME} || 'Storage.pm', __LINE__); | |
| 239 | ||
| 240 | return $total; | |
| 241 | } | |
| 242 | ||
| 243 | #---------------------------------------------------------------------- | |
| 244 | # users_needing_soft_alert($db, $dbh, $DB) | |
| 245 | # | |
| 246 | # Returns array of hashrefs: | |
| 247 | # { uid, email, plan_tier, used_bytes, hard_cap_bytes, | |
| 248 | # soft_alert_bytes, pct } | |
| 249 | # for users at or above the soft-alert threshold who have NOT been | |
| 250 | # alerted in the last SOFT_ALERT_DEBOUNCE_HOURS hours. | |
| 251 | # | |
| 252 | # Computes thresholds row-by-row (each user's hard cap depends on tier | |
| 253 | # + their override) -- there are only a few thousand users at most, so | |
| 254 | # the in-Perl loop is fine. | |
| 255 | #---------------------------------------------------------------------- | |
| 256 | sub users_needing_soft_alert { | |
| 257 | my ($self, $db, $dbh, $DB) = @_; | |
| 258 | ||
| 259 | my @candidates = $db->db_readwrite_multiple($dbh, qq~ | |
| 260 | SELECT id, email, plan_tier, upload_max_mb_override, | |
| 261 | storage_hard_cap_gb_override, storage_used_bytes, | |
| 262 | last_storage_alert_at | |
| 263 | FROM `${DB}`.users | |
| 264 | WHERE account_status = 'active' | |
| 265 | AND storage_used_bytes > 0 | |
| 266 | AND ( last_storage_alert_at IS NULL | |
| 267 | OR last_storage_alert_at < DATE_SUB(NOW(), INTERVAL ~ . SOFT_ALERT_DEBOUNCE_HOURS . qq~ HOUR) ) | |
| 268 | ~, $ENV{SCRIPT_NAME} || 'Storage.pm', __LINE__); | |
| 269 | ||
| 270 | my $alert_pct = $self->{config}->settings('storage_soft_alert_pct'); | |
| 271 | $alert_pct = 80 unless defined $alert_pct && $alert_pct =~ /^\d+$/; | |
| 272 | return () if $alert_pct <= 0; # soft alerts disabled | |
| 273 | ||
| 274 | my %tier_upload_mb = ( | |
| 275 | free => $self->{config}->settings('storage_upload_max_mb_free') || 25, | |
| 276 | pro => $self->{config}->settings('storage_upload_max_mb_pro') || 500, | |
| 277 | business => $self->{config}->settings('storage_upload_max_mb_business') || 5120, | |
| 278 | ); | |
| 279 | my %tier_hard_gb = ( | |
| 280 | free => $self->{config}->settings('storage_hard_cap_gb_free') || 5, | |
| 281 | pro => $self->{config}->settings('storage_hard_cap_gb_pro') || 200, | |
| 282 | business => $self->{config}->settings('storage_hard_cap_gb_business') || 2048, | |
| 283 | ); | |
| 284 | ||
| 285 | my @out; | |
| 286 | foreach my $r (@candidates) { | |
| 287 | next unless ref($r) eq 'HASH'; | |
| 288 | my $tier = lc($r->{plan_tier} || 'free'); | |
| 289 | $tier = 'free' unless $tier =~ /^(free|pro|business)$/; | |
| 290 | ||
| 291 | my $hard_gb = defined $r->{storage_hard_cap_gb_override} && length $r->{storage_hard_cap_gb_override} | |
| 292 | ? $r->{storage_hard_cap_gb_override} + 0 | |
| 293 | : $tier_hard_gb{$tier} + 0; | |
| 294 | my $hard_bytes = $hard_gb * 1073741824; | |
| 295 | my $soft_bytes = int($hard_bytes * $alert_pct / 100); | |
| 296 | ||
| 297 | my $used = ($r->{storage_used_bytes} || 0) + 0; | |
| 298 | next if $used < $soft_bytes; | |
| 299 | ||
| 300 | push @out, { | |
| 301 | uid => $r->{id}, | |
| 302 | email => $r->{email}, | |
| 303 | plan_tier => $tier, | |
| 304 | used_bytes => $used, | |
| 305 | hard_cap_bytes => $hard_bytes, | |
| 306 | soft_alert_bytes => $soft_bytes, | |
| 307 | pct => $hard_bytes > 0 ? int($used * 100 / $hard_bytes) : 0, | |
| 308 | }; | |
| 309 | } | |
| 310 | return @out; | |
| 311 | } | |
| 312 | ||
| 313 | #---------------------------------------------------------------------- | |
| 314 | # users_at_capacity($db, $dbh, $DB) | |
| 315 | # | |
| 316 | # Returns array of hashrefs for every active user currently at or above | |
| 317 | # the soft-alert threshold of their effective hard cap. Does NOT honor | |
| 318 | # the 24h debounce (that's only for emails) -- this is for the admin | |
| 319 | # UI banner which should always reflect the live state. Cheap: iterates | |
| 320 | # users in Perl (only a few thousand rows). | |
| 321 | #---------------------------------------------------------------------- | |
| 322 | sub users_at_capacity { | |
| 323 | my ($self, $db, $dbh, $DB) = @_; | |
| 324 | ||
| 325 | my @candidates = $db->db_readwrite_multiple($dbh, qq~ | |
| 326 | SELECT id, email, plan_tier, upload_max_mb_override, | |
| 327 | storage_hard_cap_gb_override, storage_used_bytes | |
| 328 | FROM `${DB}`.users | |
| 329 | WHERE account_status = 'active' | |
| 330 | AND storage_used_bytes > 0 | |
| 331 | ~, $ENV{SCRIPT_NAME} || 'Storage.pm', __LINE__); | |
| 332 | ||
| 333 | my $alert_pct = $self->{config}->settings('storage_soft_alert_pct'); | |
| 334 | $alert_pct = 80 unless defined $alert_pct && $alert_pct =~ /^\d+$/; | |
| 335 | return () if $alert_pct <= 0; | |
| 336 | ||
| 337 | my %tier_hard_gb = ( | |
| 338 | free => $self->{config}->settings('storage_hard_cap_gb_free') || 5, | |
| 339 | pro => $self->{config}->settings('storage_hard_cap_gb_pro') || 200, | |
| 340 | business => $self->{config}->settings('storage_hard_cap_gb_business') || 2048, | |
| 341 | ); | |
| 342 | ||
| 343 | my @out; | |
| 344 | foreach my $r (@candidates) { | |
| 345 | next unless ref($r) eq 'HASH'; | |
| 346 | my $tier = lc($r->{plan_tier} || 'free'); | |
| 347 | $tier = 'free' unless $tier =~ /^(free|pro|business)$/; | |
| 348 | ||
| 349 | my $hard_gb = defined $r->{storage_hard_cap_gb_override} && length $r->{storage_hard_cap_gb_override} | |
| 350 | ? $r->{storage_hard_cap_gb_override} + 0 | |
| 351 | : $tier_hard_gb{$tier} + 0; | |
| 352 | my $hard_bytes = $hard_gb * 1073741824; | |
| 353 | my $soft_bytes = int($hard_bytes * $alert_pct / 100); | |
| 354 | ||
| 355 | my $used = ($r->{storage_used_bytes} || 0) + 0; | |
| 356 | next if $used < $soft_bytes; | |
| 357 | ||
| 358 | push @out, { | |
| 359 | uid => $r->{id}, | |
| 360 | email => $r->{email}, | |
| 361 | plan_tier => $tier, | |
| 362 | used_bytes => $used, | |
| 363 | hard_cap_bytes => $hard_bytes, | |
| 364 | pct => $hard_bytes > 0 ? int($used * 100 / $hard_bytes) : 0, | |
| 365 | }; | |
| 366 | } | |
| 367 | return @out; | |
| 368 | } | |
| 369 | ||
| 370 | #---------------------------------------------------------------------- | |
| 371 | # stamp_soft_alert_sent($db, $dbh, $DB, $uid) | |
| 372 | # | |
| 373 | # Called by the worker after a soft-alert email is queued so the 24h | |
| 374 | # debounce kicks in. | |
| 375 | #---------------------------------------------------------------------- | |
| 376 | sub stamp_soft_alert_sent { | |
| 377 | my ($self, $db, $dbh, $DB, $uid) = @_; | |
| 378 | $uid =~ s/[^0-9]//g; | |
| 379 | return unless $uid; | |
| 380 | $db->db_readwrite($dbh, qq~ | |
| 381 | UPDATE `${DB}`.users | |
| 382 | SET last_storage_alert_at = NOW() | |
| 383 | WHERE id = '$uid' LIMIT 1 | |
| 384 | ~, $ENV{SCRIPT_NAME} || 'Storage.pm', __LINE__); | |
| 385 | } | |
| 386 | ||
| 387 | #---------------------------------------------------------------------- | |
| 388 | # users_needing_recompute($db, $dbh, $DB) | |
| 389 | # | |
| 390 | # Returns array of uids whose storage_used_at_recompute is NULL or | |
| 391 | # older than 24h. The worker iterates these and calls recompute_usage | |
| 392 | # on each so the denormalized total drifts back to truth. | |
| 393 | #---------------------------------------------------------------------- | |
| 394 | sub users_needing_recompute { | |
| 395 | my ($self, $db, $dbh, $DB) = @_; | |
| 396 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 397 | SELECT id FROM `${DB}`.users | |
| 398 | WHERE account_status = 'active' | |
| 399 | AND ( storage_used_at_recompute IS NULL | |
| 400 | OR storage_used_at_recompute < DATE_SUB(NOW(), INTERVAL 24 HOUR) ) | |
| 401 | ORDER BY storage_used_at_recompute IS NULL DESC, storage_used_at_recompute ASC | |
| 402 | LIMIT 500 | |
| 403 | ~, $ENV{SCRIPT_NAME} || 'Storage.pm', __LINE__); | |
| 404 | return map { ref($_) eq 'HASH' ? $_->{id} : () } @rows; | |
| 405 | } | |
| 406 | ||
| 407 | #---------------------------------------------------------------------- | |
| 408 | # human_size($bytes) | |
| 409 | # | |
| 410 | # Public wrapper around the internal pretty-printer so admin CGIs can | |
| 411 | # format their own values without reaching into _human_size directly. | |
| 412 | # Accepts either ($self, $bytes) or just ($bytes) for flexibility. | |
| 413 | #---------------------------------------------------------------------- | |
| 414 | sub human_size { | |
| 415 | my $bytes = (ref $_[0] || (defined $_[0] && $_[0] eq __PACKAGE__)) ? $_[1] : $_[0]; | |
| 416 | return _human_size($bytes); | |
| 417 | } | |
| 418 | ||
| 419 | #---------------------------------------------------------------------- | |
| 420 | # Pretty-print bytes -> "12.3 MB" / "4.5 GB". | |
| 421 | # Used in user-facing reject messages so they read naturally. | |
| 422 | #---------------------------------------------------------------------- | |
| 423 | sub _human_size { | |
| 424 | my ($n) = @_; | |
| 425 | $n = 0 unless defined $n; | |
| 426 | $n += 0; | |
| 427 | if ($n >= 1073741824) { | |
| 428 | return sprintf('%.1f GB', $n / 1073741824); | |
| 429 | } elsif ($n >= 1048576) { | |
| 430 | return sprintf('%.1f MB', $n / 1048576); | |
| 431 | } elsif ($n >= 1024) { | |
| 432 | return sprintf('%.1f KB', $n / 1024); | |
| 433 | } | |
| 434 | return "$n B"; | |
| 435 | } | |
| 436 | ||
| 437 | 1; |