branches/erry-devel/libs/misc.pm

   1 #       This file is part of SurrealServices.
   2 #
   3 #       SurrealServices is free software; you can redistribute it and/or modify
   4 #       it under the terms of the GNU General Public License as published by
   5 #       the Free Software Foundation; either version 2 of the License, or
   6 #       (at your option) any later version.
   7 #
   8 #       SurrealServices 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
  11 #       GNU General Public License for more details.
  12 #
  13 #       You should have received a copy of the GNU General Public License
  14 #       along with SurrealServices; if not, write to the Free Software
  15 #       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  16 package misc;
  17 use strict;
  18
  19 sub isint($) {
  20         my($x) = shift;
  21         return (int($x) eq $x);
  22 }
  23
  24 sub parse_quoted($) {
  25         my ($in) = @_;
  26         my @out;
  27
  28         my @qs = (
  29                 [qr/^\s*\"(.*?)(?<!\\)\"(.*)/,
  30                   sub { $_[0] =~ s/\\"/\"/g; return $_[0] }],
  31                 [qr/^\s*\/(.*?)(?<!\\)\/(.*)/,
  32                   sub { $_[0] =~ s#\\/#/#g; return $_[0] }],
  33                 [qr/(\S+)\s*(.*|$)/, undef]
  34         );
  35
  36         do {
  37                 foreach my $q (@qs) {
  38                         my $str;
  39                         my ($re, $trans) = @$q;
  40
  41                         if(my @x = ($in =~ $re)) {
  42                                 ($str, $in) = @x;
  43                                 $str = &$trans($str) if $trans;
  44                                 push @out, $str;
  45                                 #print "str: $str\nin: $in\n";
  46                         }
  47                 }
  48         } while($in =~ /\S/);
  49
  50         return @out;
  51 }
  52
  53 use constant { ORD_A => ord('A') };
  54
  55 sub gen_uuid($$) {
  56         my ($groups, $length) = @_;
  57         my $emailreg_code = '';
  58         for(my $i = 1; $i <= $groups; $i++) {
  59                 for (my $j = 1; $j <= $length; $j++) {
  60                         my $ch;
  61                         $emailreg_code .= (($ch = int(rand(36))) > 9 ? chr((ORD_A - 10) + $ch) : $ch);
  62                 }
  63                 $emailreg_code .= '-' unless $i >= $groups;
  64         }
  65         return $emailreg_code;
  66 }
  67
  68 1;