# ----------------------------------------------------------------------------- # Milkbone::Util # Generic Milkbone utilities # ----------------------------------------------------------------------------- package Milkbone::Util; use strict; use warnings; use dots; use Carp; our @ISA = qw(Exporter); our @EXPORT = qw(); our @EXPORT_OK = qw(slurp win32 nix nt loaded_files user_path strip_html path user_dir merge_hash); # read a file in one big slurp sub slurp { my ($file, $no_chomp) = @_; open(my $handle, $file) or die "Failed loading $file"; my @all = <$handle>; close($handle); chomp @all unless $no_chomp; if(wantarray) { return @all; } else { return join('', @all); } } # general heuristic for removing html from a string sub strip_html { $_ = shift; s/<br>/\n/gi; s/<.*?>//gi; s/&/&/gi; s/>/>/gi; s/</</gi; s/"/\"/gi; return $_; } # This code assumes that Win32 and *NIX are the only architectures milkbone # will be used on. This probably isn't that bad of an assumption, since Mac # OS X is now BSD-based. sub nix { $^O !~ /Win32/; } sub win32 { $^O =~ /Win32/; } sub nt { return unless win32(); eval 'use Win32'; return (Win32::GetOSVersion())[4]; } sub user_dir { my $user = data("me"); $ENV{HOME} ||= ''; my $dir = (nix() ? "$ENV{HOME}/.milkbone" : (exists($ENV{APPDATA}) ? "$ENV{APPDATA}/milkbone" : "profiles")); mkdir $dir unless -e $dir && -d $dir; mkdir "$dir/$user" unless -e path("$dir/$user") && -d path("$dir/$user"); return "$dir/$user"; } # Stolen from Devel::ptkdb - thanks! sub loaded_files { my @fList = sort { # sort comparison function block my $fa = substr($a, 0, 1) ; my $fb = substr($b, 0, 1) ; return $a cmp $b if ($fa eq '/') && ($fb eq '/') ; return -1 if ($fb eq '/') && ($fa ne '/') ; return 1 if ($fa eq '/' ) && ($fb ne '/') ; return $a cmp $b ; } grep s/^_<//, keys %main::; } sub path { confess "Milkbone::path is deprecated"; return @_; } 1;