code.delx.au - gnu-emacs-elpa/blob - packages/notes-mode/NotesVars.pm

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # NotesVars.pm
   5 # $Id: NotesVars.pm,v 1.8 2003/05/23 16:26:22 johnh Exp $
   6 #
   7 # Copyright (C) 1996,2012  Free Software Foundation, Inc.
   8 # Comments to <johnh@isi.edu>.
   9 #
  10 # This file is under the Gnu Public License, version 2.
  11 # For details see the COPYING which accompanies this distribution.
  12 #
  13
  14 require 5.000;
  15
  16 #
  17 # basic initialization
  18 #
  19 BEGIN {
  20     no strict 'vars';   # avoid %::notes
  21     $notes{'home'} = ((getpwuid($<))[7]);
  22     my(@config) = `"$ENV{'NOTES_BIN_DIR'}/mkconfig" perl`;
  23     die "$0: mkconfig failed\n" if ($#config == -1);
  24     eval join("", @config);
  25     unshift(@INC, $notes{'bin_dir'});
  26 }
  27
  28 package NotesVars;
  29 require Exporter;
  30
  31 @ISA = Exporter;
  32 #my(%notes);
  33 @EXPORT = qw(pathname_to_Ymd Ymd_to_epoch
  34             pathname_to_epoch epoch_to_pathname
  35             url_to_pathname
  36             strftime_epoch
  37             );
  38 use Time::Local;
  39 use POSIX qw(strftime);
  40 use strict;
  41
  42
  43 ##
  44 ## Strftime
  45 ##
  46 ## Because "use POSIX" is so slow, I wrote a standalone strftime program.
  47 ## I'm not distributing it because mknew caching seems to solve this problem.
  48 ##
  49 #
  50 #my($strftime_inited) = 0;
  51 #sub init_strftime {
  52 #    my($x);
  53 #    # We currently don't support an external strftime.
  54 #    if (-x "$::notes{'bin_dir'}/strftime" ) {
  55 #       # run the program
  56 #       $x = q<
  57 #               sub strftime_backend {
  58 #                   my($output) = `> .$::notes{'bin_dir'} .
  59 #                               q</strftime '$_[0]' $_[1]`;
  60 #                   chomp $output;
  61 #                   return $output;
  62 #               }
  63 #               >;
  64 #    } else {
  65 #       # use POSIX
  66 #       # This option is about 10 times slower to load.
  67 #       # Unfortunately eval'ing this code causes perl5.002
  68 #       # to crash on exit.
  69 #       $x = q<
  70 #               use POSIX;
  71 #               sub strftime_backend {
  72 #                   return POSIX::strftime($_[0],localtime($_[1])) ;
  73 #               }
  74 #               >;
  75 #    };
  76 #    eval $x;
  77 #    $strftime_inited = 1;
  78 #}
  79 #
  80 #sub strftime_epoch {
  81 #    &init_strftime() unless ($strftime_inited);
  82 #    return &strftime_backend(@_);
  83 #}
  84
  85 sub strftime_epoch {
  86     return POSIX::strftime($_[0], localtime($_[1]));
  87 }
  88
  89 sub pathname_to_Ymd {
  90     my($pathname) = @_;
  91     # NEEDSWORK:  not general (assumes file_form is %y%m%d)
  92     my($Y, $m, $d) = ($pathname =~ /(..)(..)(..)$/);
  93     $Y += 1900 if ($Y >= 90 && $Y < 100);
  94     $Y += 2000 if ($Y < 90 && $Y < 100);
  95     return ($Y, $m, $d);
  96 }
  97
  98 sub Ymd_to_epoch {
  99     my($y, $m, $d) = @_;
 100     $y -= 1900 if ($y > 1000);   # convert possible $Y to $y
 101     return timelocal(0, 0, 12, $d, ($m-1), $y);
 102 }
 103
 104 sub pathname_to_epoch {
 105     my($pathname) = @_;
 106     my($Y, $m, $d) = &pathname_to_Ymd($pathname);
 107     return &Ymd_to_epoch($Y, $m, $d);
 108 }
 109
 110 sub epoch_to_pathname {
 111     my($epoch) = @_;
 112     return strftime_epoch("$::notes{dir}/$::notes{int_form}/$::notes{file_form}", $epoch);
 113 }
 114
 115 sub url_to_pathname {
 116     my($url) = @_;
 117     $url =~ s@^file:///@@;
 118     my($home) = $::notes{home};
 119     $url =~ s@^\~@${home}@;
 120     $url =~ s@\#\* .*$@@;
 121     return $url;
 122 }