SL/Version.pm

   1 package SL::Version;
   2
   3 use strict;
   4
   5 our $instance;
   6
   7 sub new {
   8   bless \my $instace, __PACKAGE__;
   9 }
  10
  11 sub get_instance {
  12   $instance //= $_[0]->new;
  13 }
  14
  15 sub get_version {
  16   $$instance //= do {
  17     open my $version_file, '<', "VERSION" or die 'can not open VERSION file';
  18     my $version = <$version_file>;
  19     close $version_file;
  20
  21     if ( -f "BUILD" ) {
  22       open my $build_file, '<', "BUILD" or die 'can not open BUILD file';
  23       my $build =  <$build_file>;
  24       close $build_file;
  25       $version .= '-' . $build;
  26     }
  27
  28     # only allow numbers, letters, points, underscores and dashes. Prevents injecting of malicious code.
  29     $version =~ s/[^0-9A-Za-z\.\_\-]//g;
  30
  31     $version;
  32   }
  33 }
  34
  35 1;
  36
  37 __END__
  38
  39 =encoding utf-8
  40
  41 =head1 NAME
  42
  43 SL::Version
  44
  45 =head1 SYNOPSIS
  46
  47   use SL::Version;
  48
  49   my $version = SL::Version->get_version
  50
  51 =head1 DESCRIPTION
  52
  53 This module is a singleton for the sole reason that SL::Form doesn't have to
  54 cache the version.
  55
  56 =head1 FUNCTIONS
  57
  58 =head2 C<new>
  59
  60 Creates a new object. Should never be called.
  61
  62 =head2 C<get_instance>
  63
  64 Creates a singleton instance if none exists and returns.
  65
  66 =head2 C<get_version>
  67
  68 Parses the version from the C<VERSION> file.
  69
  70 If the file C<BUILD> exists, appends its contents as a build number.
  71
  72 Returns a sanitized version string.
  73
  74 =head1 BUGS
  75
  76 None yet :)
  77
  78 =head1 AUTHOR
  79
  80 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
  81
  82 =cut