From 2ef76f71f4a19b60ffdd2aa15ffd389039b4e659 Mon Sep 17 00:00:00 2001 From: Gerhard Gonter <ggonter@gmail.com> Date: Sun, 1 Sep 2013 10:10:33 +0200 Subject: [PATCH] first shot --- textarchive/lib/TA/ObjReg.pm | 70 ++++++++++++++++++++++++++++++++++++ textarchive/lib/TA/Util.pm | 44 +++++++++++++++++++++++ 2 files changed, 114 insertions(+) create mode 100644 textarchive/lib/TA/ObjReg.pm create mode 100644 textarchive/lib/TA/Util.pm diff --git a/textarchive/lib/TA/ObjReg.pm b/textarchive/lib/TA/ObjReg.pm new file mode 100644 index 0000000..7189420 --- /dev/null +++ b/textarchive/lib/TA/ObjReg.pm @@ -0,0 +1,70 @@ + +package TA::ObjReg; + +use strict; + +use JSON; +use TA::Util; + +sub new +{ + my $class= shift; + my %par= @_; + + # check the presence of all required parameters + my $stopit= 0; + foreach my $k (qw(project subproject)) + { + unless (exists ($par{$k})) + { + print STDERR "missing parameter '$k'\n"; + $stopit= 1; + } + } + return undef if ($stopit); + + my $obj= {}; + bless $obj, $class; + foreach my $par (keys %par) + { + $obj->{$par}= $par{$par}; + } + + $par; +} + +sub get_project +{ + my $obj= shift; + + my $proj_name= $obj->{'project'}; + my $proj_cfg_fnm= join ('/', $ENV{'TABASE'}, 'projects', $proj_name, 'config.json'); + + my $proj_cfg; + unless ($proj_cfg= TA::Util::slurp_file ($proj_cfg_fnm, 'json')) + { + print STDERR "project '$proj_name' at 'proj_cfg_fnm'\n"; + return undef; + } + +} + + +sub add +{ +} + +# =head1 INTERNAL FUNCTIONS + +1; +__END__ + +=head1 ENVIRONMENT + + +=head1 TODOs + +* this is a stub for storage in a local filesystem +** connect to centralized connection service + + diff --git a/textarchive/lib/TA/Util.pm b/textarchive/lib/TA/Util.pm new file mode 100644 index 0000000..e9dff19 --- /dev/null +++ b/textarchive/lib/TA/Util.pm @@ -0,0 +1,44 @@ + +package TA::Util; + +use strict; + +=head2 _file_slurp ($filename, $format) + +read contents of that file and + +=cut + +sub slurp_file +{ + my $fnm= shift; + my $format= shift || 'lines'; + + open (FI, $fnm) or return undef; + my @lines= <FI>; + close (FI); + + if ($format eq 'array') + { + return @lines; + } + elsif ($format eq 'arrayref') + { + return \@lines; + } + elsif ($format eq 'string') + { + return join ('', @lines); + } + elsif ($format eq 'json') + { + my $str= join ('', @lines); + return decode_json ($str); + } + + print STDERR "unknown slurp format '$format'\n"; + return undef; +} + +1; + -- GitLab