Revision 6627c9eb
Von Sven Schöling vor etwa 7 Jahren hinzugefügt
| SL/Form.pm | ||
|---|---|---|
| 79 | 79 |
use SL::Template; |
| 80 | 80 |
use SL::User; |
| 81 | 81 |
use SL::Util; |
| 82 |
use SL::Version; |
|
| 82 | 83 |
use SL::X; |
| 83 | 84 |
use Template; |
| 84 | 85 |
use URI; |
| ... | ... | |
| 91 | 92 |
use strict; |
| 92 | 93 |
|
| 93 | 94 |
sub read_version {
|
| 94 |
my ($self) = @_; |
|
| 95 |
|
|
| 96 |
open VERSION_FILE, "VERSION"; # New but flexible code reads version from VERSION-file |
|
| 97 |
my $version = <VERSION_FILE>; |
|
| 98 |
$version =~ s/[^0-9A-Za-z\.\_\-]//g; # only allow numbers, letters, points, underscores and dashes. Prevents injecting of malicious code. |
|
| 99 |
close VERSION_FILE; |
|
| 100 |
|
|
| 101 |
return $version; |
|
| 95 |
SL::Version->get_version; |
|
| 102 | 96 |
} |
| 103 | 97 |
|
| 104 | 98 |
sub new {
|
| 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 |
|
Auch abrufbar als: Unified diff
SL::Version - Versionsbehandlung aus Form ausgelagert