"Fossies" - the Fresh Open Source Software Archive

Member "absence-v2.1/utils/AbsenceMigration.pm" (20 Oct 2013, 17193 Bytes) of package /linux/www/web-absence-2.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "AbsenceMigration.pm" see the Fossies "Dox" file reference documentation.

    1 #======================================================================
    2 #    This file is part of Absence.
    3 #
    4 #    Absence is free software: you can redistribute it and/or modify
    5 #    it under the terms of the GNU General Public License as published by
    6 #    the Free Software Foundation, either version 3 of the License, or
    7 #    (at your option) any later version.
    8 #
    9 #    Absence is distributed in the hope that it will be useful,
   10 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
   11 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12 #    GNU General Public License for more details.
   13 #
   14 #    You should have received a copy of the GNU General Public License
   15 #    along with Absence.  If not, see <http://www.gnu.org/licenses/>.
   16 #======================================================================
   17 
   18 # copyright Robert Urban
   19 
   20 package AbsenceMigration;
   21 
   22 use FileHandle;
   23 use Encode qw(encode decode from_to decode_utf8);
   24 
   25 use AbsenceUtils;
   26 #use AbsenceInstall;
   27 
   28 use strict;
   29 
   30 my $DEBUG = 0;
   31 my $DBH;
   32 my $LOGFH;
   33 
   34 my %PERSON_KEYS = (
   35     name        => '',
   36     id          => '',
   37     user_id     => '',
   38     email       => '',
   39     group       => '',      # reference to list of GIDs
   40 );
   41 my @RES_KEYS        = qw(id person_id start end type desc misc);
   42 my %RESERVATION_KEYS = (
   43     id          => '',      # unique number
   44     person_id   => '',      # unique number
   45     start       => '',      # date. array-ref in form [d,m,y]
   46     end         => '',      # date. array-ref in form [d,m,y]
   47     type        => '',      # single word "vacation", "busy", "travel"
   48     desc        => '',      # arbitrary text
   49     misc        => '',      # more arbitrary text
   50 );
   51 my %GROUP_KEYS = (
   52     id          => '',
   53     name        => '',
   54     pass        => '',
   55 );
   56 my %USER_KEYS = (
   57     user_id     => '',
   58     password    => '',
   59     pacl        => '',
   60     gacl        => '',
   61 );
   62 
   63 sub migrateData
   64 {
   65     my $config_ref = shift;
   66 
   67     my $logfile = "/tmp/absence-migration-$$.log";
   68     openlog($logfile);
   69     my $data_dir = getDataDir();
   70     miglog("data-dir = [$data_dir]", 1);
   71 
   72     miglog("** migrating types **", 1);
   73     my $type_map = migrateTypes($data_dir);
   74 
   75     my $db_file = "$data_dir/absence.db";
   76     -f $db_file || die "db-file not found";
   77 
   78     miglog("** reading data file **", 1);
   79     my $data = readDbFile($db_file);
   80 
   81     # migrate groups
   82     miglog("** migrating groups **", 1);
   83     my $group_info = migrateGroups($data->{groups});
   84 
   85     # migrate people
   86     miglog("** migrating people **", 1);
   87     migratePeople($config_ref, $data, $group_info);
   88     if ($config_ref->{authentication} eq 'yes') {
   89         miglog("** migrating users **", 1);
   90         migrateUsers($config_ref, $data);
   91         miglog("** migrating ACLs **", 1);
   92         migrateAcls($config_ref, $data, $group_info);
   93     }
   94 
   95     # migrate reservations!
   96     miglog("** migrating reservations **", 1);
   97     migrateReservations($config_ref, $data, $type_map);
   98 
   99     closelog();
  100     print qq{log written to "$logfile".\n};
  101 }
  102 
  103 sub migrateReservations
  104 {
  105     my ($config_ref, $data, $type_map) = @_;
  106 
  107     #my $dbh = connectDb(
  108     #   $config_ref->{database_user},
  109     #   $config_ref->{database_pass},
  110     #   $config_ref->{database_name},
  111     #   $config_ref->{database_host},
  112     #   undef,
  113     #);
  114     #defined($dbh) || die "failed to connect to DB";
  115 
  116     my $migrated = 0;
  117 
  118     foreach my $rid (keys(%{ $data->{reservations} })) {
  119         miglog("  rid=$rid");
  120         my $rref = $data->{reservations}->{$rid};
  121         my $start = {
  122             day     => $rref->{start}->[0],
  123             month   => $rref->{start}->[1],
  124             year    => $rref->{start}->[2],
  125         };
  126         my $end = {
  127             day     => $rref->{end}->[0],
  128             month   => $rref->{end}->[1],
  129             year    => $rref->{end}->[2],
  130         };
  131         my $type = $rref->{type};
  132         if (!exists($type_map->{$type})) {
  133             miglog("    cannot migrate res=$rid, type [$type] not found");
  134             next;
  135         }
  136         my $type_id = $type_map->{$type};
  137         my $pid = $rref->{person_id};
  138         if (!exists($data->{people}->{$pid})) {
  139             miglog("    cannot migrate res=$rid, pid [$pid] not found");
  140             next;
  141         }
  142         if (!exists($data->{people}->{$pid}->{new_pid})) {
  143             miglog("    cannot migrate res=$rid, pid [$pid] was not migrated");
  144             next;
  145         }
  146         my $new_pid = $data->{people}->{$pid}->{new_pid};
  147         my $res;
  148         my $desc = convertString($rref->{desc});
  149         eval {
  150             $res = AbsenceDB::_addReservation(
  151                 'new', $new_pid, $start, $end, $type_id, $desc
  152             );
  153         };
  154         if ($@) {
  155             miglog("    failed to migrate res=$rid.");
  156         }
  157         elsif (defined($res)) {
  158             miglog("    successfully migrated reservation.");
  159             $migrated++;
  160         }
  161     }
  162     miglog("    migrated $migrated reservations", 1);
  163 }
  164 
  165 sub _convertString
  166 {
  167     my $str = shift;
  168 
  169     my $copy = $str;
  170     my $decoded;
  171     eval {
  172         $decoded = decode('utf8', $copy, 1);
  173     };
  174     if ($@) {
  175         # decode failed. assume iso-8859-1
  176         $decoded = decode('iso-8859-1', $str);
  177     }
  178 
  179     return $decoded;
  180     #return encode('utf8', $decoded);
  181 }
  182 
  183 sub convertString
  184 {
  185     my $str = shift;
  186 
  187     return encode('utf8', $str);
  188 }
  189 
  190 sub convertDate
  191 {
  192     my $ref = shift;
  193 
  194     return join('-', reverse(@{ $ref }));
  195 }
  196 
  197 sub migrateTypes
  198 {
  199     my $data_dir = shift;
  200 
  201     #--------------------------------------------------------
  202     # types first
  203     #--------------------------------------------------------
  204     my $types_file = "$data_dir/absence-types.db";
  205     -f $types_file || die "types-file not found";
  206 
  207     miglog("  opening types file");
  208     my $types = readTypesFile($types_file);
  209 
  210     my $migrated = 0;
  211     my $map;
  212     my $ref;
  213     foreach my $type_name (keys(%{ $types->{db} })) {
  214         miglog("  migrating type [$type_name]");
  215         my @cols = @{ $types->{db}->{$type_name} };
  216         $ref = {
  217             name        => convertString($type_name),
  218             color_red   => $cols[0],
  219             color_green => $cols[1],
  220             color_blue  => $cols[2],
  221             height      => 'full',
  222             priority    => 1,
  223         };
  224         if (defined($types->{default}) && ($types->{default} eq $type_name)) {
  225             $ref->{default_type} = 't';
  226         }
  227         my $id = AbsenceDB::addType($ref);
  228         miglog("    type created with id=$id");
  229         $migrated++;
  230         $map->{$type_name} = $id;
  231     }
  232 
  233     miglog("    migrated $migrated types.", 1);
  234     return $map;
  235 }
  236 
  237 sub migrateGroups
  238 {
  239     my $groups = shift;
  240 
  241     my $group_info;
  242 
  243     my $migrated = 0;
  244 
  245     foreach my $gid (keys(%{ $groups })) {
  246         my $name = convertString($groups->{$gid}->{name});
  247         miglog("  migrating group [$name] with gid=$gid");
  248         my ($res, $new_gid) = AbsenceDB::addGroup('new', $name, undef, undef);
  249         if ($res eq 'ok') {
  250             $group_info->{$gid} = { name => $name, new_id => $new_gid };
  251             miglog("    new gid = $new_gid");
  252             $migrated++;
  253         }
  254         else {
  255             miglog("    failed to migrate group. res=[$res]");
  256         }
  257     }
  258 
  259     miglog("    migrated $migrated groups.", 1);
  260     return $group_info;
  261 }
  262 
  263 sub migratePeople
  264 {
  265     my ($config_ref, $data, $group_info) = @_;
  266 
  267     my $auth = $config_ref->{authentication} eq 'yes';
  268 
  269     my @params;
  270 
  271     my $migrated = 0;
  272 
  273     foreach my $pid (keys(%{ $data->{people} })) {
  274         my $pref = $data->{people}->{$pid};
  275         miglog("  processing pid=$pid ($pref->{name})");
  276         my $gref = convertGroups($group_info, $pref->{group});
  277         miglog("    groups: old=".join(',', @{ $pref->{group} })
  278             ." new=".join(',', @{ $gref }));
  279         my $uref;
  280         @params = (
  281             'new',
  282             convertString($pref->{name}),
  283             '',
  284             $pref->{email},
  285             $gref,
  286         );
  287         if ($auth
  288             && exists($pref->{user_id})
  289             && exists($data->{users}->{ $pref->{user_id} }))
  290         {
  291             my $user = $pref->{user_id};
  292             $uref = $data->{users}->{$user};
  293             $uref->{attached} = 1;
  294             push(@params, $uref->{password}, undef, undef);
  295             $params[2] = $user;
  296         }
  297         elsif ($auth) {
  298             if (!exists($pref->{user_id})) {
  299                 miglog("    no user in DB for person [$pref->{name}]");
  300             } elsif (!exists($data->{users}->{ $pref->{user_id} })) {
  301                 miglog("    cannot find user [$pref->{user_id}] in USERS");
  302             }
  303         }
  304         my ($res, $new_pid, $uid) = AbsenceDB::addPerson(@params);
  305         if ($res eq 'ok') {
  306             miglog("    person [$pref->{name}] migrated. new pid = $new_pid");
  307             $pref->{new_pid} = $new_pid;
  308             $uref->{new_uid} = $uid;
  309             $migrated++;
  310         }
  311         else {
  312             miglog("    failed to create person [$pref->{name}]");
  313         }
  314     }
  315     miglog("    migrated $migrated people.", 1);
  316 }
  317 
  318 sub migrateUsers
  319 {
  320     my ($config_ref, $data) = @_;
  321 
  322     my $migrated = 0;
  323 
  324     foreach my $username (keys(%{ $data->{users} })) {
  325         my $uref = $data->{users}->{$username};
  326         miglog("  processing user [$username]");
  327         exists($uref->{attached}) && next;
  328         $username = convertString($username);
  329         my ($res, $uid) = AbsenceDB::addUser($username, $uref->{password}, undef, undef);
  330         if ($res eq 'ok') {
  331             miglog("  user [$username] migrated. new uid = $uid");
  332             $uref->{new_uid} = $uid;
  333             $migrated++;
  334         }
  335         else {
  336             miglog("    failed to migrate user [$username]. res=[$res]");
  337         }
  338     }
  339     miglog("    migrated $migrated people.", 1);
  340 }
  341 
  342 sub migrateAcls
  343 {
  344     my ($config_ref, $data, $group_info) = @_;
  345 
  346     foreach my $username (keys(%{ $data->{users} })) {
  347         my $uref = $data->{users}->{$username};
  348         miglog("  processing ACLs for user [$username]");
  349         if (!exists($uref->{new_uid})) {
  350             miglog("    skipping acls for user [$username] because migrate failed");
  351             next;
  352         }
  353         my ($pacl_ref, $gacl_ref)
  354             = convertAcls($group_info, $data, $uref->{pacl}, $uref->{gacl});
  355         miglog("  migrating ACLs for user [$username]");
  356         AbsenceDB::setAcls($uref->{new_uid}, $pacl_ref, $gacl_ref);
  357     }
  358 }
  359 
  360 #--------------------------------------------------------------------
  361 # convertAcls()
  362 #
  363 # gets old pacls and gacls in the form "[war]:(self|all|ID)"
  364 # and converts them to form
  365 # $ref = {
  366 #   target  => (self|all|ID),
  367 #   level   => 1|2|4,
  368 # }
  369 #--------------------------------------------------------------------
  370 sub convertAcls
  371 {
  372     my ($group_info, $data, $old_pacl, $old_gacl) = @_;
  373 
  374     my %levmap = (r => 1, w => 2, a => 4);
  375 
  376     my ($paclr, $gaclr);
  377 
  378     my @new_pacl;
  379     foreach my $acl (@{ $old_pacl }) {
  380         my ($perm, $pid) = ($acl =~ /^([war]):(.*)$/);
  381         if (!defined($perm)) {
  382             miglog("    failed to match ACL [$acl]");
  383             next;
  384         }
  385         my $level = $levmap{$perm};
  386         if ($pid =~ /^(all|self)$/) {
  387             push(@new_pacl, {
  388                 target  => $pid,
  389                 level   => $level,
  390             });
  391             next;
  392         }
  393         if (!exists($data->{people}->{$pid})) {
  394             miglog("    pid [$pid] unknown.");
  395             next;
  396         }
  397         my $pref = $data->{people}->{$pid};
  398         if (!exists($pref->{new_pid})) {
  399             miglog("    skipping ACL [$acl] because migration failed.");
  400         }
  401         push(@new_pacl, {
  402             target  => $pref->{new_pid},
  403             level   => $level,
  404         });
  405     }
  406 
  407     my @new_gacl;
  408     foreach my $acl (@{ $old_gacl }) {
  409         my ($perm, $gid) = ($acl =~ /^([war]):(.*)$/);
  410         if (!defined($perm)) {
  411             miglog("    failed to match ACL [$acl]");
  412             next;
  413         }
  414         my $level = $levmap{$perm};
  415         if ($gid =~ /^(all|self)$/) {
  416             push(@new_gacl, {
  417                 target  => $gid,
  418                 level   => $level,
  419             });
  420             next;
  421         }
  422         if (!exists($group_info->{$gid})) {
  423             miglog("    gid [$gid] unknown.");
  424             next;
  425         }
  426         if (!exists($group_info->{$gid})) {
  427             miglog("    skipping ACL [$acl] because no group mapping.");
  428             next;
  429         }
  430         my $gref = $group_info->{$gid};
  431 
  432         push(@new_gacl, {
  433             target  => $gref->{new_id},
  434             level   => $level,
  435         });
  436     }
  437 
  438     return (\@new_pacl, \@new_gacl);
  439 }
  440 
  441 sub convertGroups
  442 {
  443     my ($group_info, $gref) = @_;
  444 
  445     my @result;
  446     foreach my $old (@{ $gref }) {
  447         next unless (exists($group_info->{$old}));
  448         push(@result, $group_info->{$old}->{new_id});
  449     }
  450 
  451     return \@result;
  452 }
  453 
  454 sub getDataDir
  455 {
  456     my $data_dir;
  457     my $finished = 0;
  458     do {
  459         $data_dir = query(
  460             'Directory where old datafiles are located',
  461             '',
  462             undef,
  463             0,
  464             0,
  465         );
  466         if (! -d $data_dir) {
  467             print "[$data_dir] is not a directory, or does not exist\n";
  468         } elsif (! -f "$data_dir/absence.db") {
  469             print qq{file "absence.db" not found in directory [$data_dir]\n};
  470         } else {
  471             $finished = 1;
  472         }
  473     } while(!$finished);
  474 
  475     return $data_dir;
  476 }
  477 
  478 sub readHolidays
  479 {
  480     my $file = shift;
  481 
  482     my ($day, $month, $year, $desc);
  483     my $data;
  484 
  485     my $fh = FileHandle->new($file);
  486     defined($fh) || die "open [$file] for reading";
  487     while(<$fh>) {
  488         chomp;
  489         ($DEBUG > 1) && print "HOLIDAY> $_\n";
  490         if (/^\s*$/) { next; }
  491         if (/^\s*#$/) { next; }
  492         if (/^(\d+)\.(\d+).(\d+|\*)\t(\S+(\s+\S+)*)\s*$/) {
  493             ($day, $month, $year, $desc) = ($1, $2, $3, $4);
  494             $DEBUG && print "match: d=[$day], m=[$month], y=[$year], d=[$desc]\n";
  495             #push(@{$DB{$month}->{$year}}, [$day, $month, $year, $desc]);
  496             $data->{$year}->{$month}->{$day} = _convertString($desc);
  497         }
  498     }
  499     $fh->close;
  500 
  501     return $data;
  502 }
  503 
  504 sub readDbFile
  505 {
  506     my $file = shift;
  507 
  508     my $mode = '';
  509     my $in_block = 0;
  510     my ($key, $val);
  511     my $curr;
  512 
  513     $DEBUG && miglog("read file.");
  514     my $fh = FileHandle->new($file);
  515     defined($fh) || die "readDbFile: failed to open file [$file]: $!";
  516 
  517     $DEBUG && miglog("reading DB");
  518 
  519     my %GROUPS          = ();
  520     my %PEOPLE          = ();
  521     my %RESERVATIONS    = ();
  522     my %USERS           = ();
  523 
  524     while(<$fh>) {
  525         chomp;
  526         $_ = decode('iso-8859-1', $_);
  527         ($DEBUG > 2) && print "LINE: $_\n";
  528         if (/^\s*#/) { next; }      # skip WS
  529         if (/^PEOPLE:/) {
  530             $mode = 'people';
  531             next;
  532         } elsif (/^RESERVATIONS:/) {
  533             $mode = 'reservations';
  534             ($DEBUG > 2) && print "found RESERVATIONS:\n";
  535             next;
  536         } elsif (/^GROUPS:/) {
  537             $mode = 'groups';
  538             ($DEBUG > 2) && print "found GROUPS:\n";
  539             next;
  540         } elsif (/^USERS:/) {
  541             $mode = 'users';
  542             ($DEBUG > 2) && print "found USERS:\n";
  543             next;
  544         }
  545     
  546         if ($mode eq 'people') {
  547             if ($in_block) {
  548                 if (/^END/) {
  549                     $in_block = 0;
  550                     if (!exists($curr->{id})) {
  551                         die "no id found for person [$curr->{name}]";
  552                     }
  553                     if (exists($PEOPLE{$curr->{id}})) {
  554                         die "person ID [$curr->{id}] occurs twice";
  555                     }
  556                     if (!exists($curr->{group})) {
  557                         $curr->{group} = [1];
  558                     }
  559                     $PEOPLE{$curr->{id}} = $curr;
  560                     undef $curr;
  561                     next;
  562                 }
  563                 if (/^\s*(\S+):\s*(\S+(\s+\S+)*)\s*$/) {
  564                     ($key, $val) = ($1, $2);
  565                     if (exists($PERSON_KEYS{$key})) {
  566                         if ($key eq 'group') {
  567                             $curr->{$key} = [split(/,/, $val)];
  568                         } else {
  569                             $curr->{$key} = $val;
  570                         }
  571                     }
  572                 }
  573             } elsif (/^START/) {
  574                 $in_block = 1;
  575             }
  576         } elsif ($mode eq 'reservations') {
  577             if ($in_block) {
  578                 if (/^END/) {
  579                     $in_block = 0;
  580                     ($DEBUG > 2) && print "END: id = $curr->{id}\n";
  581                     if (!exists($curr->{id})) {
  582                         die "no id found for reservation [$curr->{start}]";
  583                     }
  584                     if (exists($RESERVATIONS{$curr->{id}})) {
  585                         die "reservation ID [$curr->{id}] occurs twice";
  586                     }
  587                     $curr->{sjd} = AbsenceDate::julianDay(@{$curr->{start}});
  588                     $curr->{ejd} = AbsenceDate::julianDay(@{$curr->{end}});
  589                     $RESERVATIONS{$curr->{id}} = $curr;
  590                     undef $curr;
  591                     next;
  592                 }
  593                 if (/^\s*(\S+):\s*(\S+(\s+\S+)*)\s*$/) {
  594                     ($key, $val) = ($1, $2);
  595                     ($DEBUG > 2) && print "key = [$key], val = [$val]\n";
  596                     if (exists($RESERVATION_KEYS{$key})) {
  597                         ($DEBUG > 2) && print "setting \$curr->{$key} = [$val]\n";
  598                         if ($key =~ /^(start|end)$/) {
  599                             $curr->{$key} = [split(/\./,$val)];
  600                         } else {
  601                             $curr->{$key} = $val;
  602                         }
  603                     }
  604                 }
  605             } elsif (/^START/) {
  606                 $in_block = 1;
  607                 next;
  608             }
  609         } elsif ($mode eq 'groups') {
  610             if ($in_block) {
  611                 if (/^END/) {
  612                     $in_block = 0;
  613                     ($DEBUG > 2) && print "END: id = $curr->{id}\n";
  614                     if (!exists($curr->{id})) {
  615                         die "no id found for group [$curr->{name}]";
  616                     }
  617                     if (exists($GROUPS{$curr->{id}})) {
  618                         die "group ID [$curr->{id}] occurs twice";
  619                     }
  620                     $GROUPS{$curr->{id}} = $curr;
  621                     #$GROUP_COUNT++;
  622                     undef $curr;
  623                     next;
  624                 }
  625                 if (/^\s*(\S+):\s*(\S+(\s+\S+)*)\s*$/) {
  626                     ($key, $val) = ($1, $2);
  627                     ($DEBUG > 2) && print "key = [$key], val = [$val]\n";
  628                     if (exists($GROUP_KEYS{$key})) {
  629                         ($DEBUG > 2) && print "setting \$curr->{$key} = [$val]\n";
  630                         $curr->{$key} = $val;
  631                     }
  632                 }
  633             } elsif (/^START/) {
  634                 $in_block = 1;
  635                 next;
  636             }
  637         } elsif ($mode eq 'users') {
  638             if ($in_block) {
  639                 if (/^END/) {
  640                     $in_block = 0;
  641                     ($DEBUG > 2) && print "END: id = $curr->{user_id}\n";
  642                     if (!exists($curr->{user_id})) {
  643                         die "no id found for user [$curr->{user_id}]";
  644                     }
  645                     if (exists($USERS{$curr->{user_id}})) {
  646                         die "user ID [$curr->{user_id}] occurs twice";
  647                     }
  648                     $USERS{$curr->{user_id}} = $curr;
  649                     #$USER_COUNT++;
  650                     undef $curr;
  651                     next;
  652                 }
  653                 if (/^\s*(\S+):\s*(\S+(\s+\S+)*)\s*$/) {
  654                     ($key, $val) = ($1, $2);
  655                     ($DEBUG > 2) && print "key = [$key], val = [$val]\n";
  656                     if ($key =~ /acl$/) {
  657                         $val = [split(/,/, $val)];
  658                     }
  659                     if (exists($USER_KEYS{$key})) {
  660                         ($DEBUG > 2) && print "setting \$curr->{$key} = [$val]\n";
  661                         $curr->{$key} = $val;
  662                     }
  663                 }
  664             } elsif (/^START/) {
  665                 $in_block = 1;
  666                 next;
  667             }
  668         }
  669     }
  670 
  671     $fh->close;
  672 
  673     return {
  674         groups          => \%GROUPS,
  675         people          => \%PEOPLE,
  676         reservations    => \%RESERVATIONS,
  677         users           => \%USERS,
  678     };
  679 }
  680 
  681 sub readTypesFile
  682 {
  683     my $file = shift;
  684 
  685     my $default;
  686     my %db;
  687 
  688     my $fh = FileHandle->new($file);
  689     defined($fh) || die "open $file for reading";
  690     my ($type, $color);
  691     while(<$fh>) {
  692         if (/^\s*#/) { next; }
  693         if (/^\s*$/) { next; }
  694         if (/^Type:\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s*(#.*)?$/) {
  695             $type = $1;
  696             my @cols = ($2, $3, $4);
  697             $color = [colcon(@cols)];   # rgb
  698             $db{$type} = $color;
  699         } elsif (/^\s*Default: (\S+)\s*$/) {
  700             $default = $1;
  701         }
  702     }
  703     $fh->close;
  704 
  705     return { db => \%db, default => $default };
  706 }
  707 
  708 sub colcon
  709 {
  710     my (@list) = @_;
  711 
  712     my @new;
  713     foreach my $col (@list) {
  714         ($col =~ /^0x/i) ? push(@new, hex($col)) : push(@new, $col);
  715     }
  716 
  717     @new;
  718 }
  719 
  720 sub openlog
  721 {
  722     my $file = shift;
  723 
  724     $LOGFH = FileHandle->new($file, 'w');
  725     defined($LOGFH) || die "failed to open logfile [$file] for writing: $!";
  726 }
  727 
  728 sub closelog
  729 {
  730     $LOGFH->close;
  731 }
  732 
  733 sub miglog
  734 {
  735     my ($msg, $show) = @_;
  736 
  737     print $LOGFH "$msg\n";
  738     $show && print "$msg\n";
  739 }
  740 
  741 1;