File Coverage

blib/lib/Text/Mining/Base.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Text::Mining::Base;
use Class::Std;
use Class::Std::Utils;
use DBIx::MySperqlOO;
use File::Spec;
use YAML qw(DumpFile LoadFile);
use Module::Runtime qw(use_module);

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv('0.0.8');

our $config_filename = '.corpus/config';
our $status_filename = '.tm-status';

{
	my %library_dbh_of     : ATTR();
	my %analysis_dbh_of    : ATTR();
	my %root_dir_of        : ATTR();
	my %root_url_of        : ATTR();

	sub library              { my ( $self ) = @_; return $library_dbh_of{ident $self}; }
	sub analysis             { my ( $self ) = @_; return $analysis_dbh_of{ident $self}; }

	sub get_root_url         { my ( $self ) = @_; return $root_url_of{ident $self}; }
	sub get_root_dir         { my ( $self ) = @_; return $root_dir_of{ident $self}; }
	sub get_data_dir         { my ( $self, $corpus_id ) = @_; return $self->get_root_dir() . "/documents/corpus_$corpus_id"; }
	sub get_config_filename  { return File::Spec->catfile( $ENV{HOME}, $config_filename ); }
	sub get_status_filename  { return File::Spec->catfile( $ENV{HOME}, $status_filename ); }

	sub BUILD {
		my ($self, $ident, $arg_ref) = @_;

		my $config = $self->_load_config();

		$root_dir_of{$ident}        = $config->{root_dir};
		$root_url_of{$ident}        = $config->{root_url};

		$library_dbh_of{$ident}     = DBIx::MySperqlOO->new( $config->{library} );
		$analysis_dbh_of{$ident}    = DBIx::MySperqlOO->new( $config->{analysis} );

		return;
	}

	sub get_corpus_id_from_name {
		my ( $self, $arg_ref ) = @_;
		my $sql = "select corpus_id from corpuses where corpus_name = '" . $arg_ref->{corpus_name} . "'";
	   	my ( $corpus_id ) = $self->library()->sqlexec( $sql, '@' );
	        return $corpus_id;
	}

	sub _load_config {
		my ( $self ) = @_;
		return LoadFile( $self->get_config_filename() );
	}

	sub _parse_file_name {
		my ( $self, $url ) = @_;
		my @path  = split(/\//, $url);
		return pop(@path);
	}

	sub _download_file {
		my ( $self, $arg_ref ) = @_;
		my @stat;
		my $target_dir = defined $arg_ref->{target_dir} ? $arg_ref->{target_dir} : '';
		my $url        = defined $arg_ref->{url} ? $arg_ref->{url} : '';
		my $tries      = defined $arg_ref->{tries} ? $arg_ref->{tries} : 2;
		if ($target_dir && $url) {
			my $file_name  = $self->_parse_file_name( $url );
			my $wget  = "wget --tries=$tries --directory-prefix=$target_dir $url";
			`$wget`;
			@stat = stat("$target_dir/$file_name");
		}
	  	return $stat[7] || '0';
	}

	sub _sql_escape {
		my ( $self, $string ) = @_;
		if ($string) { $string =~ s/(['"\\])/\\$1/g; }
		return $string;
	}

	sub _html_to_sql {
		my ( $self, $string ) = @_;
		$string = $self->_html_unescape( $string );
		$string = $self->_sql_escape( $string );
		return $string;
	}

	sub _html_escape {
		my ( $self, $string ) = @_;
		$string =~ s/'/'/g;
		$string =~ s/"/"/g;
		return $string;
	}

	sub _html_encode {
		my ( $self, $string ) = @_;
		$string =~ s/ /%20/g;
		$string =~ s/'/%27/g;
		$string =~ s/\{/%7B/g;
		$string =~ s/\}/%7D/g;
		return $string;
	}

	sub _html_unescape {
		my ( $self, $string ) = @_;
		$string =~ s/'/'/g;
		$string =~ s/"/"/g;
		$string =~ s/%20/ /g;
		return $string;
	}

	sub _phone_format {
		my ( $self, $string ) = @_;
		$string =~ s/(\d{3})(\d{3})(\d{4})/($1) $2-$3/;
		return $string;
	}

	sub _phone_unformat {
		my ( $self, $string ) = @_;
		$string =~ s/[^\d]//g;
		return $string;
	}

	sub _commify { # Perl Cookbook 2.17
		my ( $self, $string ) = @_;
		my $text = reverse $string;
		$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
		return scalar reverse $text;
	}

	sub _get_files {
		my ( $self, $root_dir ) = @_;
		if (opendir(DIR, $root_dir)) {
			my (@files);
			my (@nodes) = (readdir(DIR));

			foreach my $node (@nodes) {
				if ($node =~ m/^\./) { next; }

	          		my $pathnode = $root_dir . "/" . $node;
				my @stat = stat($pathnode);

				my $value = defined $stat[2] ? $stat[2] : '';
				if ($value =~ /^[^1]/) {
					push(@files, $node);
			  	}
			}
			return @files;
		} else {
			return 0;
		}
	}

	sub _get_dirs {
		my ( $self, $path, $nestedflag) = @_;

		# If the directory opens
		if (opendir(DIR, $path)) {
			# Read it
			my (@dirs);
			my (@nodes) = sort (readdir(DIR));

			foreach my $node (@nodes) {
			  # Drop any dirs (or files) that start with a period
			  if ($node =~ m/^\./) { next; }

			  # Get file system node status
			  my @stat = stat($path . '/' . $node);

			  # if the first character of $mode is 1, then it is a dir
			  if ($stat[2] =~ /^1/) {
			    my $newpath = $path . "/" . $node;
			    push(@dirs, $newpath);

			    if ($nestedflag) {
			      my @subnodes = &GetDirs($newpath, $nestedflag);
			      push(@dirs, @subnodes);
			    }
			  }
			}
			return @dirs;
		} else {
			return 0;
		}
	}

	sub _get_file_text {
		my ( $self, $path_file_name ) = @_;
		my ($text, $line);
		if (-e $path_file_name) {
			open  (my $IN, '<', $path_file_name) || $self->_status( "(Get) Cannot open $path_file_name: $!" );
			while ($line = <$IN>) { $text .= $line; }
			close ($IN)                          || $self->_status( "(Get) Cannot close $path_file_name: $!" );
		}
		return $text;
	}

	sub _set_file_text {
		my ( $self, $path_file_name, $text ) = @_;
		open  (my $OUT, '>', $path_file_name)        || $self->_status( "(Set) Cannot open $path_file_name: $!" );
		print {$OUT} $text                           || $self->_status( "(Set) Cannot write $path_file_name: $!" );
		close ($OUT)                                 || $self->_status( "(Set) Cannot close $path_file_name: $!" );
	}

	sub _add_file_text {
		my ( $self, $path_file_name, $text ) = @_;
		open  (my $OUT, '>>', $path_file_name)       || $self->_status( "(Add) Cannot open $path_file_name: $!" );
		print {$OUT} $text                           || $self->_status( "(Add) Cannot write $path_file_name: $!" );
		close ($OUT)                                 || $self->_status( "(Add) Cannot close $path_file_name: $!" );
	}

	sub _status {
		my ( $self, $msg ) = @_;
		my $status_file = $self->get_status_filename();
		open  (my $OUT, '>>', $status_file)          || croak( "(Status) Cannot open $status_file: $!" );
		print {$OUT} "  STATUS: $msg \n"             || croak( "(Status) Cannot write $status_file: $!" );
		close ($OUT)                                 || croak( "(Status) Cannot close $status_file: $!" );
		return;
	}
}

1; # Magic true value required at end of module
__END__