libropkg-perl 0.4-1 / usr / share / perl5 / RoPkg / Utils.pm

############################################################################
##      Copyright (C) 2005 Subredu Manuel  <diablo@iasi.roedu.net>.        #
##                                                                         #
## This program is free software; you can redistribute it and/or modify    #
## it under the terms of the GNU General Public License as published by    #
## the Free Software Foundation; either version 2 of the License, or       #
## (at your option) any later version.                                     #
##                                                                         #
## This program is distributed in the hope that it will be useful,         #
## but WITHOUT ANY WARRANTY; without even the implied warranty of          #
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the           #
## GNU General Public License for more details.                            #
##                                                                         #
## You should have received a copy of the GNU General Public License       #
## along with this program; if not, write to the Free Software             #
## Foundation, Inc., 59 Temple Place - Suite 330, Boston,                  #
## MA 02111-1307,USA.                                                      #
############################################################################

package RoPkg::Utils;

use strict;
use warnings;

use vars qw($VERSION @EXPORT_OK);
$VERSION = '0.4.6';

use Scalar::Util qw(blessed);
use English      qw( -no_match_vars );
use Digest::MD5;
use Exporter 'import';

@EXPORT_OK = qw(CheckParam ZeroPad ElemInList GetHumanDate SecToTime AddSlash DelSlash
                CreateFile ReadFile GetMonthsNo CleanURI CleanPath GetMD5);

use RoPkg::Exceptions;

my $months = {
  'January'   => '1',
  'Jan'       => '1',
  'February'  => '2',
  'Feb'       => '2',
  'March'     => '3',
  'Mar'       => '3',
  'April'     => '4',
  'Apr'       => '4',
  'May'       => '5',
  'June'      => '6',
  'Jun'       => '6',
  'July'      => '7',
  'Jul'       => '7',
  'August'    => '8',
  'Aug'       => '8',
  'September' => '9',
  'Sep'       => '9',
  'Octomber'  => '10',
  'Oct'       => '10',
  'November'  => '11',
  'Nov'       => '11',
  'December'  => '12',
  'Dec'       => '12',
};

sub new {
  my ($class, %opt) = @_;
  my $self;

  $self = bless { %opt }, $class;

  return $self;
}

sub CheckParam {
  my ($self, $object, @param_list) = @_;

  if ( !$self || (! defined $object) ) {
    Param::Missing->throw(
      error    => 'object is undefined',
      pkg_name => 'RoPkg::Utils',
    );
  }
 
  if (ref $self ne 'RoPkg::Utils') {
    #it looks like we have been called like RoPkg::Utils::CheckParam($object,...)

    #the $object is actually a parameter
    push @param_list, $object;

    #and the $object is $self :)
    $object = $self;
  }

  if ( scalar @param_list == 0 ) {
    Param::Missing->throw(
      error    => 'No parameters found in list',
      pkg_name => 'RoPkg::Utils',
    );
  }

  #this one is tricky. Since $object is a blessed object,
  #we have to make the diference between a RoPkg::Utils
  #instance and the instance of the ref($object) class.

  if ( (! defined $object) || (ref $object eq q{})) {
    Param::Wrong->throw(
      error    => 'object is not a class instance',
      pkg_name => 'RoPkg::Utils',
    );
  }

  foreach(@param_list) {
    my $p_name = $_;
    
    if ( !$object->{$p_name} ) {
      Param::Missing->throw(
        error    => "$p_name is not defined !",
        pkg_name => ref $object,
      );
    }
  }

  return @param_list;
}

sub ZeroPad {
  my ($self, $number, $len) = @_;
  my $result = q{};

  if ( ! defined $self ) {
    Param::Wrong->throw('No valid param value found');
  }

  if (!blessed($self)) {
    $len = $number;
    $number  = $self;
  }

  if ( (! defined $number) || $number !~ m{(\d|\.|\-)+}xm ) {
    Param::Wrong->throw('No valid number found');
  }

  if ( ( defined $len) && ($len !~ m{\d+}xm)) {
    Param::Wrong->throw('Length is not a number');
  }

  #check if the number is negative
  if ( $number < 0 ) {
    $result = q{-};
    $number = abs $number;
  }
  
  #if no len was specified we make it bigger with 1 than the length of the number
  if (!$len) {
    $len = (length($number)+1);
  }

  #if the number is negative we have to substract 1 
  #from the final number length (the minus sign)
  if ($result eq q{-}) {
    $len--;
  }

  $result .= (0 x ($len - length $number ));
  $result .= $number;

  return $result;
}

sub GetMonthNo
{
  my ($self, $month_name, $padding) = @_;

  if ( ! defined $self ) {
    Param::Missing->throw('No parameter specified');
  }

  if ( !blessed($self) ) {
    $padding = $month_name;
    $month_name = $self;
  }

  if ((defined $padding) && ($padding !~ m{\d+}xm )) {
    Param::Wrong->throw('padding is not a number');
  }
  if ( ! exists $months->{$month_name} ) {
    Param::Unknown->throw('Month ' . $month_name . ' not found');
  }

  return $months->{$month_name} if (! $padding);
  return ZeroPad($months->{$month_name}, $padding);
}

sub ElemInList
{
  my ($self, $e_name, @e_list) = @_;

  if (! defined $self) {
    Param::Missing->throw('No parameter specified');
  }

  if ( !blessed($self)) {
    push @e_list, $e_name;
    $e_name = $self;
  }

  return 0 if ( ($#e_list == -1) || (! defined $e_list[0]));

  foreach(@e_list) {
    return 1 if ( $_ eq $e_name );
  }

  return 0;
}

sub GetHumanDate
{
  my ($self, $timestamp) = @_;

  if (! defined $self) {
    Param::Missing->throw('No parameter specified');
  }

  if ( !blessed($self) ) {
    $timestamp = $self;
  }

  if (! defined $timestamp) {
    Param::Missing->throw('timestamp was not specified');
  }
  if ( $timestamp !~ m{\d+}xm ) {
    Param::Wrong->throw('timestamp does not look like a number to me');
  }

  my @items = localtime $timestamp ;

  return sprintf '%s/%s/%s %s:%s',
                 ($items[5]+1900),
                 ZeroPad($items[4]+1, 2),
                 ZeroPad($items[3], 2),
                 ZeroPad($items[2], 2),
                 ZeroPad($items[1], 2);
}

sub SecToTime
{
  my ($self, $sec) = @_;

  if (! defined $self) {
    Param::Missing->throw('No parameter specified');
  }

  if ( !blessed($self) ) {
    $sec = $self;
  }

  if (! defined $sec) {
    Param::Missing->throw('sec is not defined');
  }
  if ( $sec !~ m{\d+}xm ) {
    Param::Wrong->throw('sec does not look like a positive number to me');
  }

  my ($days, $hours, $min, $res);

  $days = int $sec / 86_400;
  $sec  = $sec - ($days * 86_400);

  $hours = int $sec / 3600;
  $sec   = $sec - ($hours * 3600);

  $min   = int $sec / 60;
  $sec   = $sec - ($min * 60);

  # res is empty in the first place
  $res = q{};

  if ( $days == 1 ) {
    $res .= '1 day';
  }
  elsif ( $days > 1 ) {
    $res .= ($days . ' days ');
  }

  $res .= join q{:}, ZeroPad($hours, 2), ZeroPad($min, 2), ZeroPad($sec, 2);
  return $res;
}

sub AddSlash
{
  my ($self, $string) = @_;

  if (! defined $self) {
    Param::Missing->throw('No parameter specified');
  }

  if ( !blessed($self) ) {
    $string = $self;
  }

  if (! defined $string) {
    Param::Missing->throw('Undefined string');
  }

  return ($string . q{/}) if ( $string !~ m{.*\/}xm );
  return $string;
}

sub DelSlash
{
  my ($self, $string) = @_;

  if (! defined $self) { 
    Param::Missing->throw('No parameter specified');
  }

  if ( !blessed($self) ) {
    $string = $self;
  }

  if (! defined $string) {
    Param::Missing->throw('Undefined string');
  }

  return ($string) if ( $string !~ m{.*\/}xm );

  chop $string;
  return $string;
}

sub CreateFile
{
  my ($self, $filename, $content) = @_;
  my $fh;

  if ( ! defined $self ) {
    Param::Missing->throw('No parameter specified');
  }

  if ( !blessed($self)) {
    $content = $filename;
    $filename = $self;
  }

  if ( ! defined $filename ) {
    Param::Missing->throw('Undefined filename');
  }

  if ( $filename =~ m{^\s*$}xm ) {
    Param::Wrong->throw('Filename must not be empty');
  }

  if ( ! open $fh, '>', $filename ) {
    File::Create->throw('Could not create ' . $filename . $RS . $ERRNO . $RS);
  }
  if ( defined $content ) {
    print $fh $content;
  }

  close $fh;
  return 1;
}

sub ReadFile
{
  my ($self, $filename) = @_;
  my ($res,$fh);

  if ( ! defined $self ) {
    Param::Missing->throw('No parameter specified');
  }

  if ( !blessed($self) ) {
    $filename = $self;
  }

  if ( ! defined $filename ) {
    Param::Missing->throw('Undefined filename');
  }
  if ( $filename =~ m{^\s*$}xm ) {
    Param::Wrong->throw('Filename must not be empty');
  }

  if ( ! open $fh, '<', $filename ) {
    File::Open->throw('Could not open ' . $filename . $RS . $ERRNO . $RS);
  }

  $res = do { local $RS; <$fh> };
  close $fh;

  return $res;
}

sub CleanURI {
  my ($self, $uri) = @_;
  my ($proto, $path);

  if ( (!$self && !$uri) || (blessed($self) && !$uri) ) {
    Param::Missing->throw(
      error    => 'uri not specified in the parameters list',
      pkg_name => 'RoPkg::Utils',
    );
  }

  if ( !$uri ) {
    $uri = $self;
  }

  if ( $uri =~ m{^(http|ftp|rsync) :// (.*)$}xm ) {
    $proto = $1;
    $path  = $2;
  }
  else {
    return $uri;
  }

  $path =~ s{(\/){2,}}{\/}xmg;

  return ($proto . '://' . $path);
}

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

  if ( (!$self && !$path) || (blessed($self) && !$path) ) {
    Param::Missing->throw(
      error    => 'path not specified in the parameters list',
      pkg_name => 'RoPkg::Utils',
    );
  }

  if ( !$path ) {
    $path = $self;
  }

  $path =~ s{(\/){2,}}{\/}xmg;

  return $path;
}

sub GetMD5 {
  my ($self, $path) = @_;
  my ($digest, $fh);
  
  if ( (!$self && !$path) || (blessed($self) && !$path) ) {
    Param::Missing->throw(
      error    => 'path not specified in the parameters list',
      pkg_name => 'RoPkg::Utils',
    );
  }

  if (!blessed($self)) {
    $path = $self;
  }

  if ( ! open $fh, '<', $path ) {
    File::Open->throw(
      error    => 'Could not open ' . $path . $RS . $ERRNO,
      pkg_name => 'RoPkg::Utils',
      filename => $path,
    );
  }
  
  $digest = new Digest::MD5;
  $digest->addfile($fh);  
  close $fh;

  return $digest->hexdigest();
}

1;

__END__

=head1 NAME

RoPkg::Utils - general pourpose class. 

=head1 VERSION

0.4.6

=head1 DESCRIPTION

RoPkg::Utils is a collection of methods used by all other
modules in RoPkg.

=head1 SYNOPSIS

 #!/usr/bin/perl

 use strict;
 use warnings;

 use RoPkg::Utils;
 
 sub main {
   my $u = new RoPkg::Utils;
 
   print $u->ZeroPad(1),$/,
         $u->ZeroPad(1, 3),$/,
         RoPkg::Utils::ZeroPad(1, 3),$/;
 
   eval {
     $u->CreateFile('/tmp.xyz', 'test message');
   };
 
   if (my $e = Exception::Class->caught('File::Create')) {
     print $e->message,$/;
     exit(1);
   }
 
   return 0;
 }
 
 main();

 When we run this, we have:

 01
 001
 001
 Could not create /tmp.xyz
 Permission denied

=head1 SUBROUTINES/METHODS

=over 12

=item new()

=item CheckParam($object, @param_list)

=item ZeroPad($number, $pad_length)

=item GetMonthNo($month_name, $padding)

=item ElemInList($element_name, @element_list)

=item GetHumanDate($timestamp)

=item SecToTime($seconds)

=item AddSlash($text)

=item DelSlash($text)

=item CreateFile($file_path, $content)

=item ReadFile($file_path)

=item CleanURI($uri)

=item CleanPath($path)

=item GetMD5($path)

=back

All methods raise the following exceptions:

=over 2

=item *) B<Param::Missing> when a required parameter is not found
in the parameters list.

=item *) B<Param::Wrong> when a parameter does not comply with
the rules. For example when a method expects a number and finds
a string.

=back

Besides these exceptions, each method might raise some specific
exceptions (see I<CreateFile>). I<new()> is provided for OO. It
doesn't do anything special, besides the blessing.

=head1 Methods details

RoPkg::Utils exports all the methods from the above list. Of course,
you can select which ones you want to import.

=head3 Example:

 use RoPkg::Utils qw(ZeroPad);
 
 sub main {
   print ZeroPad(1, 3),$/;
 }

 main();


=head2 CheckParam

Check if the parameters from the list are defined inside the object.
If the parameters are not defined Param::Missing exception is raised.

=head3 Example

 package RoPkg::TesterPkg;
 
 sub new {
   my ($class, %opt) = @_;
   my $self;
 
   $self = bless { %opt }, $class;
 
   $self->_test_options_1();
   $self->_test_options_2();
   
   return $self;
 }
 
 sub _test_options_1 {
   my ($self) = @_;
 
   RoPkg::Utils::CheckParam($self, qw(dbo dbo_method));
 
   return 1;
 }
 
 sub _test_options_2 {
   my ($self) = @_;
   my $ru;
 
   $ru = new RoPkg::Utils;
   $ru->CheckParam($self, qw(dbo dbo_method));
 
   return 1;
 }
 
 1;

=head2 ZeroPad

This method is usefull when you need to pad with zeroes some numbers. For the 
moment positive and negative numbers are suported (only integer ones). This
method takes 2 parameters B<$number> and B<$pad_length>. The B<$number> is
the number who is going to be padded, B<$pad_length> is the maximum length.
Zeroes are added until $pad_length is reached. If $pad_length is not defined,
length($number)+1 is used. If $pad_length is less than number length, no
padding is done. Ex:
 ZeroPad(1, 2)  => 01
 ZeroPad(12, 5) => 00012
 ZeroPad(-3, 4) => -003
 ZeroPad(10, 2) => 10

=head2 GetMonthNo

Used to find a month numeric index (1..12). For the moment full month names
and short month names (first 3 letters) are supported. 2 parameters may be 
passed to this method: B<$month_name> and B<$padding>. $month_name must be 
January .. December or Jan .. Dec . If the month_name is not found, 
Param::Unknown exception is raised. $padding is used to pad the numeric 
index of the month. When padding is not defined, no padding is made. Ex:
 GetMonthNo('Jan') => 1
 GetMonthNo('Jan', 2) => 01
 GetMonthNo('January') => 1
 GetMonthNo('January', 2) => 01

=head2 ElemInList

Takes two parameters. A element value and a list of elements. The methods,
search the element value within the list. Returns 1 if the element was found,
0 otherwise. Ex:
 ElemInList(1, qw(1 2 3 4)) => 1
 ElemInList(1, qw(2 3 4))   => 0

=head2 GetHumanDate

Converts the timestamp to YYYY/MM/DD HH:MM format. Ex:
 GetHumanDate(12345678) => '1970/05/23 23:21'

=head2 SecToTime

Converts the seconds to <x days> HH:MM:SS format. Ex:
 SecToTime(3)  => 00:00:03
 SecToTime(61) => 00:01:01

=head2 AddSlash

Adds a slash at the end of the string, if the slash is not present.
Othewise, leaves the string untouched. Ex:
 AddSlash('mydirectory') => 'mydirectory/'
 AddSlash('/tmp/') => '/tmp/';

=head2 DelSlash

Removes the slash from the end of the string. If the string has multiple
slashes, only the last one is removed. If the string doesn't have any
slashes at the end, no modification is made. Ex:
 DelSlash('/tmp/') => '/tmp'
 DelSlash('/tmp//') => '/tmp/'

=head2 CreateFile

Creates a file (with the filename specified), and optionally set the content
of the file to the one specified by $content variable. If $content is not
defined, the file is just created. If the file can't be created I<File::Create>
exception is raised. Returns 1 upon success.

=head2 ReadFile

Reads the content of the specified file into a variable. If the file can't
be opened a I<File::Open> exception is raised. On success returns the file content
or !defined if the file is empty.

=head2 CleanURI($uri)

Cleans the $uri from the excedent / -es .

=head3 Example:

 my $uri = 'http://www.packages.ro//test///uri';
 $uri = CleanURI($uri);
 print $uri,$RS;

 the result is:
 http://www.packages.ro/test/uri

CleanURI recognise only ftp,http and rsync uri's . Any other
uri is ignored

=head2 CleanPath($path)

Cleans the $path from the excedent / -es .

=head3 Example:

 my $path = '/var/ftp/mirrors///pub//debian.org//';
 $path = CleanPath($path);
 print $path, $RS;

 the result is:
 /var/ftp/mirrors/pub/debian.org/

=head2 GetMD5($path)

Returns the base64 md5 sum for the specified file.

=head1 DEPENDENCIES

RoPkg::Utils requires perl 5.008 or later and the following modules:

=over 5

=item Test::More

=item Test::Pod::Coverage

=item Exception::Class >= 1.21

=item Scalar::Util

=item Exporter

=back

=head1 DIAGNOSTICS

To run the tests for this module, unpack the source
and use 'make test' command to run the tests.

=head1 CONFIGURATION AND ENVIRONMENT

This module does not use any configuration files or
environment variables.

=head1 INCOMPATIBILITIES

None known to the author

=head1 BUGS AND LIMITATIONS

None known to the author

=head1 PERL CRITIC

The code for this module is perl critic level 2 compliant

=head1 SEE ALSO

L<RoPkg::Exceptions>

=head1 AUTHOR

Subredu Manuel <diablo@iasi.roedu.net>

=head1 LICENSE AND COPYRIGHT

Copyright (C) 2005 Subredu Manuel.  All Rights Reserved.
This module is free software; you can redistribute it 
and/or modify it under the same terms as Perl itself.
The LICENSE file contains the full text of the license.

=cut