EmailReminder/Utils.pm

   1 # This file is part of Email-Reminder.
   2 #
   3 # Email-Reminder is free software; you can redistribute it and/or
   4 # modify it under the terms of the GNU General Public License as
   5 # published by the Free Software Foundation; either version 3 of the
   6 # License, or (at your option) any later version.
   7 #
   8 # Email-Reminder is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 # General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with Email-Reminder; if not, write to the Free Software
  15 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16 # 02110-1301, USA.
  17
  18 package EmailReminder::Utils;
  19
  20 # Utility subroutines for the Email-Reminder program
  21
  22 use strict;
  23 use warnings;
  24
  25 use XML::DOM;
  26
  27 our $VERSION = '0.7.8';
  28 our $USER_CONFIG_FILE = '.email-reminders';
  29 our $SPOOL_DIRECTORY = '/var/spool/email-reminder';
  30
  31 my %names = (
  32     1 => "Paper",
  33     2 => "Cotton",
  34     3 => "Leather",
  35     4 => "Linen",
  36     5 => "Wood",
  37     6 => "Iron",
  38     7 => "Copper",
  39     8 => "Bronze",
  40     9 => "Pottery",
  41     10 => "Tin",
  42     11 => "Steel",
  43     12 => "Silk",
  44     13 => "Lace",
  45     14 => "Ivory",
  46     15 => "Crystal",
  47     20 => "China",
  48     25 => "Silver",
  49     30 => "Pearl",
  50     35 => "Jade",
  51     40 => "Ruby",
  52     45 => "Sapphire",
  53     50 => "Golden",
  54     55 => "Emerald",
  55     60 => "Diamond",
  56 );
  57
  58 sub get_node_value
  59 {
  60     my $node = shift;
  61     my $tag_name = shift;
  62
  63     $node = $node->getElementsByTagName($tag_name, 0)->item(0);
  64     return unless $node;
  65
  66     $node = $node->getFirstChild;
  67     return unless $node;
  68
  69     return $node->getNodeValue;
  70 }
  71
  72 sub set_node_value
  73 {
  74     my ($node, $tag_name, $new_value) = @_;
  75
  76     my $subnode = $node->getElementsByTagName($tag_name, 0)->item(0);
  77     if (!defined($subnode))
  78     {
  79         $subnode = $node->getOwnerDocument()->createElement($tag_name);
  80         $node->appendChild($subnode);
  81         $subnode->addText($new_value);
  82     }
  83     else
  84     {
  85         my $textnode = $subnode->getFirstChild();
  86         if (!defined($textnode))
  87         {
  88             $subnode->addText($new_value);
  89         }
  90         else
  91         {
  92             $textnode->setNodeValue($new_value);
  93         }
  94     }
  95     return 1;
  96 }
  97
  98 # Returns the proper English qualifier for this number
  99 sub get_th
 100 {
 101     my $number = shift;
 102     return unless defined($number);
 103
 104     if ($number >= 11 && $number <= 13) {
 105         return "th";
 106     } elsif ($number % 10 == 1) {
 107         return "st";
 108     } elsif ($number % 10 == 2) {
 109         return "nd";
 110     } elsif ($number % 10 == 3) {
 111         return "rd";
 112     } else {
 113         return "th";
 114     }
 115 }
 116
 117 # Returns the traditional name for this occurence of the anniversary
 118 # if applicable (e.g. Silver, Golden, Diamond)
 119 # (see http://www.the-inspirations-store.com/acatalog/anniversary.html)
 120 sub get_special_name
 121 {
 122     my $occurence = shift;
 123
 124     return unless exists $names{$occurence};
 125     return "($names{$occurence}) ";
 126 }
 127
 128 # Return some general-purpose debugging info
 129 sub debug_info
 130 {
 131     my $obj = shift;
 132     my $depth_level = shift;
 133
 134     my $ret = "\nEmail-reminder: ".$EmailReminder::Utils::VERSION;
 135     $ret .= "\nPerl: $] ($^O)";
 136
 137     local $ENV{PATH};
 138     $ENV{PATH} = ''; # remove potentially tainted path
 139     $ENV{ENV} = ''; # necessary on SUSE
 140     my $distro = `/usr/bin/lsb_release -s -d`; chomp $distro;
 141     my $kernel = `/bin/uname -a`; chomp $kernel;
 142     $ret .= "\nOS: $distro";
 143     $ret .= "\nKernel: $kernel";
 144
 145     use Data::Dumper;
 146     local $Data::Dumper::Maxdepth;
 147     $Data::Dumper::Maxdepth = $depth_level;
 148     $ret .= "\nObject:";
 149     $ret .= Dumper($obj);
 150 }
 151
 152 1;