milkbone/lib/Milkbone/Util.pm

# -----------------------------------------------------------------------------
# Milkbone::Util
# Generic Milkbone utilities
# -----------------------------------------------------------------------------

package Milkbone::Util;

use strict;
use warnings;

use Carp;

our @ISA = qw(Exporter);
our @EXPORT = qw();
our @EXPORT_OK = qw(slurp win32 nix nt loaded_files user_path strip_html path);

# 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/&amp;/&/gi;
	s/&gt;/>/gi;
	s/&lt;/</gi;
	s/&quot;/\"/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_file
{
	my ($file) = @_;
	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 path("$dir/$user") unless -e path("$dir/$user") && -d path("$dir/$user");

	return path("$dir/$user/$file");
}

# 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;